56 - Obtener parte del contenido de una celda para dar formato.

 Sabemos dar formato a celdas y rangos: negrita, colores, otra fuente, etc.

Pero ¿cómo podemos dar otro formato a solo parte del contenido parcial de una celda?

Utilizando la función INSTR([posición inicial], cadena donde buscar, cadena a buscar, [coincidencia])

Veamos 2 ejemplos:

Ejemplo 1:  Tenemos una factura (nota de débito, albarán o presupuesto, etc). Y deseamos 'hacer notar' de alguna manera las marcas de los productos facturados.

Lo que se necesita es una columna auxiliar con las marcas de los productos que facturamos. Esta columna se crea directamente desde el mismo código, tomando esa información de la tabla de productos.

Luego se recorrerá esa columna auxiliar en todas las filas de la hoja Factura, cambiando la fuente y color de fuente, no a toda la celda sino solamente al texto encontrado.

Sub marcaNegrita()     'hoja Factura

'buscar fin de rango en la hoja de productos.... Ajustar al modelo

Set hox = Sheets("Productos")

x = hox.Range("C" & Rows.Count).End(xlUp).Row

'copiar col C a la col auxiliar E y quitar duplicados ... Ajustar al modelo

With hox

    .Columns("C:C").Copy Destination:=.[E1]

    .Range("$E$1:$E$" & x).RemoveDuplicates Columns:=1, Header:=xlYes

    'se guarda el nuevo fin de rango para la col E

    x = .Range("E" & Rows.Count).End(xlUp).Row

End With

'recorre la col E buscando esos textos en la hoja Factura, col B

'se sabe que la lista de productos facturados va de 10 a 13....Ajustar al modelo

For I = 2 To x

    'se guarda la marca sin posibles espacios

    dato = Trim(hox.Range("E" & I).Text)   

    For y = 10 To 13

        'se la busca en la celda de la factura, a partir de la posición 1 

       ubica = InStr(1, Range("B" & y), dato, 0)    

        'si la función InStr devuelve un valor se toma la cadena a partir de esa ubicación

        If ubica > 0 Then   

            With Range("B" & y).Characters(ubica, Len(dato)).Font     

                'la función Len devuelve la longitud del dato

                .FontStyle = "Negrita"

                .ColorIndex = 3

            End With

        End If

    Next y

Next I

MsgBox "Fin del proceso."

End Sub

Ejemplo 2:  A partir de una plantilla o documento modelo, se busca completar los campos modificables mediante un formato en negrita.

Se necesitará una columna con la lista de campos modificables, una columna con los valores con los que se rellenará la plantilla y una hoja auxiliar para dejar el documento formateado listo para imprimir.

Como el documento se rellena con fórmulas utilizando la función BuscarV, luego desde la macro lo que haremos es copiar el rango del documento, en este caso col A:G a la hoja auxiliar, solo valores y formatos. 

Y en esta hoja resultado, recorriendo la col de datos modificables, se irán buscando esos textos en las cadenas de cada fila, marcándolos en negrita.

Sub enNegrita()   'hoja Contrato

'ultimas filas con datos de la hoja principal, hoja activa

x = Range("K" & Rows.Count).End(xlUp).Row

f = Range("A" & Rows.Count).End(xlUp).Row

'se copia el rango del documento en otra hoja auxiliar, como 'solo valores'

'quitando previamente col utilizadas con anterioridad

Set hox = Sheets("Cto final")     'ajustar el nombre de la hoja auxiliar

hox.Columns("A:G").Delete

Columns("A:G").Copy

    hox.Range("A1").PasteSpecial Paste:=xlValues, Operation:= _

        xlNone, SkipBlanks:=False, Transpose:=False

    hox.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

        SkipBlanks:=False, Transpose:=False

'recorre la col de textos a formatear, buscandolos en hoja auxiliar

For I = 2 To x

    If Range("K" & I) <> "" Then

        dato = Trim(Range("K" & I).Text)  

        'para mantener los formatos de importes y fechas

        For y = 2 To f

            ubica = InStr(1, hox.Range("A" & y), dato, 0)

            If ubica > 0 Then

                With hox.Range("A" & y).Characters(ubica, Len(dato)).Font

                    .FontStyle = "Negrita"

                    '.ColorIndex = 5

                End With

            End If

        Next y

    End If

Next I

'altos de fila

For I = 2 To f

    alto = Range("A" & I).RowHeight

    hox.Range("A" & I).RowHeight = alto

Next I

hox.Select

[A1].Select

MsgBox "Fin del proceso."

End Sub

Descargar libro de ejemplo desde aquí.

Acceso al VIDEO Nº 56 desde aquí.