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í.
