Macro para aplicar Negrita en un texto concatenado con Rango Fijo

0


 

Código:


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, palabras As Variant, t As Variant

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.Characters.Font.Bold = False

palabras = Split(c.Text, " ")

For Each t In palabras

If WorksheetFunction.CountIf(B, t) > 0 Then

c.Characters(InStr(c.Text, t), Len(t)).Font.Bold = True

End If

Next t

Next c

Application.EnableEvents = True

If Not celdaActiva Is Nothing Then celdaActiva.Select

End If

End Sub


Entradas que pueden interesarte

Entradas más recientes Entradas antiguas

Sin comentarios

Etiquetas:
#aprendiendoexcel365, #josealcaldealias, #Excel, #funciones, #UDF, #Visual Basic, #VBA, #DAX, #Tips, #Basico, #Microsoft Excel, #Cursos Excel OnLine, #Aprende Excel, #Aprende Excel OnLine, #Excel 365, #Power Pivot, #Power BI, #Power Query, #Google Sheets, #Macros, #Código VBA, #Tutoriales Excel, #MTV, #Vbscript, #TypeScript, #Lenguaje M, #fórmulas, #funciones, #paso a paso, #funciones Excel, #libros, #tablas, #formatos, #hojas, #datos, #gráfico, #análisis de datos, #base de datos, #dashboards, #tablas dinámicas, #excel desde cero, #hoja de cálculo, #plantillas de Excel