Macro para aplicar Negrita en texto concatenado en una Tabla (al añadir nuevos datos)

0



 Código:


Private Sub Worksheet_Change(ByVal Target As Range)


If Not Intersect(Target, ListObjects("").DataBodyRange) Is Nothing Then

Dim t As ListObject, o As ListColumn, x As ListColumn, d As ListColumn, c As Range, p As Variant, y As Variant

Set t = ListObjects("")

Set o = t.ListColumns("")

Set d = t.ListColumns("")

p = Array("")

Set c = ActiveCell


Application.EnableEvents = False

d.DataBodyRange.Value = o.DataBodyRange.Value

For Each celda In d.DataBodyRange

celda.Characters.Font.Bold = False

ys = Split(celda.Value, " ")

For Each y In ys

For Each columnaName In p

Set x = t.ListColumns(columnaName)

If WorksheetFunction.CountIf(x.DataBodyRange, y) > 0 Then

celda.Characters(InStr(celda.Value, y), Len(y)).Font.Bold = True

Exit For

End If

Next columnaName

Next y

Next celda

Application.EnableEvents = True

If Not c Is Nothing Then c.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