Aplicar Negrita en Textos Concatenados en Formatos de Tabla

0

 

Código:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim t As ListObject

    Dim o As ListColumn

    Dim d As ListColumn

    Dim j As Range

    Dim g As Range

    Dim r As Long

    Dim e As ListColumn

    Dim c As Variant

    Dim n As Variant

    

    Set t = Me.ListObjects("")

    Set o = t.ListColumns("")

    Set d = t.ListColumns("")

    

    c = Array("")

    

    If Intersect(Target, t.DataBodyRange) Is Nothing Then Exit Sub

    

    Application.EnableEvents = False

    d.DataBodyRange.Value = o.DataBodyRange.Value

    d.DataBodyRange.Font.Bold = False

    

    For Each g In d.DataBodyRange

        For Each n In c

            Set e = t.ListColumns(n)

            For Each j In e.DataBodyRange

                If j.Value <> "" Then

                    r = InStr(1, g.Value, j.Value, vbTextCompare)

                    If r > 0 Then

                        g.Characters(r, Len(j.Value)).Font.Bold = True

                    End If

                End If

            Next j

        Next n

    Next g

    

    Application.EnableEvents = True

End Sub


⭐ Si te gustó, por favor regístrate en nuestra Lista de correo y Suscríbete a mi canal de YouTube para que estés siempre enterado de lo nuevo que publicamos.


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