Macro para aplicar negrita en texto concatenado en rango fijo en Excel
Código para Rango Fijo
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, ) Is Nothing Then
Dim o As Range, R As Range, B As Range, C As Range
Dim celdaActiva As Range
Set o = Range("")
Set R = Range("")
Set B = Range("")
Set celdaActiva = ActiveCell
Application.EnableEvents = False
R.Value = o.Value
For Each C In R
C.Font.Bold = False
For Each bCell In B
If InStr(1, C.Text, bCell.Value) > 0 Then
posInicial = InStr(1, C.Text, bCell.Value)
longitud = Len(bCell.Value)
C.Characters(posInicial, longitud).Font.Bold = True
End If
Next bCell
Next C
Application.EnableEvents = True
If Not celdaActiva Is Nothing Then celdaActiva.Select
End If
End Sub
Código para Rango Dinámico
...
codigo para que no solo cambie a la primera palabra encontrada sino a todas
ResponderEliminarPrivate Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E3:E5")) Is Nothing Then
Dim o As Range, R As Range, B As Range, C As Range
Dim palabra As Variant
Dim celdaActiva As Range
Set o = Range("E18:E22") ' Rango con los datos concatenados
Set R = Range("A18:A22") ' Rango resultado
Set B = Range("E2:E5") ' Rango con las palabras que se pondrán en negrita
Set celdaActiva = ActiveCell
Application.EnableEvents = False
R.Value = o.Value
For Each C In R
C.Font.Bold = False
For Each palabra In Split(C.Text) ' Separar la concatenación en palabras
For Each bCell In B
If palabra = bCell.Value Then
posInicial = 1
Do While posInicial > 0 ' Continuar buscando la palabra en la celda
posInicial = InStr(posInicial, C.Text, palabra)
If posInicial > 0 Then
longitud = Len(palabra)
C.Characters(posInicial, longitud).Font.Bold = True
posInicial = posInicial + longitud ' Mover la posición de inicio después de la última ocurrencia
End If
Loop
End If
Next bCell
Next palabra
Next C
Application.EnableEvents = True
If Not celdaActiva Is Nothing Then celdaActiva.Select
End If
End Sub
Muy agradecido por el codigo, tengo una pregunta. Como podria ejecutar esta macro con un boton? Gracias
ResponderEliminarSaludos, le puede servir esto https://youtu.be/UFRo0AzgAnI?si=pA7pJNv2cWjOqlGd
EliminarHola buenas tardes
ResponderEliminarEste codigo es muy útil, gracias por compartir.
Una pregunta, es posible utilizar este codigo si el dato a poner en negrita está en una hoja diferente del mismo libro?