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

'x Elsamatilde

'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

    dato = Trim(hox.Range("E" & I).Text)   'se guarda la marca sin posibles espacios

    For y = 10 To 13

        ubica = InStr(1, Range("B" & y), dato, 0)    'se la busca en la celda de la factura, a partir de la posición 1

        If ubica > 0 Then   'si la función InStr devuelve un valor se toma la cadena a partir de esa ubicación

            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

'x Elsamatilde

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

Ver video 56 desde aquí.

55 - Propiedad 'HasFormula' en VBA

 En Excel tenemos la función ESFORMULA para determinar si una celda contiene valores o fórmula, devolviendo VERDADERO en caso de que la tenga.

            =ESFORMULA(E3) 

En VBA, también podemos necesitar esta información para tomar alguna decisión. Y para ello utilizaremos la propiedad 'HasFormula' de la celda. 

En esta entrada veremos 2 casos concretos de cómo evaluar esta situación.

CASO 1: si por alguna razón la hoja no puede ser protegida, pero necesitamos impedir que se modifiquen sus fórmulas. 

Lo que haremos es evaluar la situación al momento de seleccionar una celda y en caso de que contenga fórmula, pasar a la celda siguiente. Esto lo controlamos desde el evento SelectionChange de la hoja.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.HasFormula Then Target.Offset(0, 1).Select

       'If Target.Row < 3 Then Target.Offset(1, 0).Select

End Sub

Nota: La segunda instrucción no tiene que ver con las fórmulas pero nos sirve para impidir que se modifiquen títulos o encabezados de tablas en una hoja sin protección.

CASO 2: cuando necesitamos agregar algún argumento o alguna otra función a un rango de celdas.

Es un caso frecuente cuando olvidamos agregar la función SI.ERROR en cualquier función que presenta nuestra hoja. Y con las siguientes macros que colocaremos en un módulo, lograremos modificar la celda activa (opción 1) o un rango dentro de la hoja (opción 2).

Opción 1: Solo para la celda activa. Recomiendo utilizar un atajo de teclado para ejecutarla.

Sub cambiaFormula_celda()

'Opción 1: solo la celda activa. Para este caso podrías utilizar un atajo de teclado

'atajo de teclado: CTRL f

 

 With ActiveCell

    If .HasFormula Then

        cadena = Mid(.FormulaR1C1, 2, Len(.FormulaR1C1) - 1)

        'se evalúa si todavía no tiene la función SI.ERROR, en ese caso lo agrega

        If Left(cadena, 7) <> "IFERROR" Then

            .FormulaR1C1 = "=IFERROR(" & cadena & ","""")"

        End If

    End If

End With

End Sub

Opción 2: Para un rango seleccionado previamente. También en este caso es posible utilizar un atajo de teclado para ejecutarla. 

Sub cambiaFormula_seleccion()

'x Elsamatilde

'atajo de teclado: CTRL h

 

'Opción 2: recorriendo el rango previamente seleccionado

'tratándose de un rango extenso es conveniente pasar el modo de cálculo

'a manual para que no recalcule en cada celda y evitar así demoras en el proceso

Application.Calculation = xlCalculationManual

'se recorre cada celda de la selección, evaluando si tiene fórmula o no

For Each cd In Selection

    If cd.HasFormula Then

    'se obtiene la fórmula a partir de la posición 2

        cadena = Mid(cd.FormulaR1C1, 2, Len(cd.FormulaR1C1) - 1)

        'si los 7 1ros caracteres no mencionan iferror se arma la nueva fórmila

        If Left(cadena, 7) <> "IFERROR" Then

            'el última argumento es vacío. Puede ser 0 o algún otro valor.

            cd.FormulaR1C1 = "=IFERROR(" & cadena & ","""")"

        End If

    End If

Next cd

'volver el modo de cálculo a automático

Application.Calculation = xlCalculationAutomatic

'opcional: enviar un mensaje de fin

MsgBox "Fin del proceso.", , "Información"

End Sub

Nota: si el rango es muy extenso como para seleccionarlo previamente, agregar la siguiente instrucción marcada de color (ajustando al rango deseado):

Sub cambiaFormula_seleccion()

'x Elsamatilde

'atajo de teclado: CTRL h

'Opción 2: recorriendo el rango previamente seleccionado

'tratándose de un rango extenso es conveniente pasar el modo de cálculo

'a manual para que no recalcule en cada celda y evitar así demoras en el proceso

Application.Calculation = xlCalculationManual

Range("A2:K200").Select

'se recorre cada celda de la selección, evaluando si tiene fórmula o no

For Each cd In Selection

     '................ continúa la macro.

End Sub

           

El libro con los ejemplos puede ser descargado desde aquí.

Ver video 55 desde aquí.

54 - BUSCARV vs INDICE+COINCIDIR.

No siempre la función BUSCARV nos resuelve una búsqueda de cierta información según el criterio empleado. Por ejemplo, si tenemos una tabla de varias columnas y el criterio se encuentra en una columna central como en la imagen.

BUSCARV nos devolverá la información a derecha. Y para obtener la de la izquierda utilizaremos lasfunciones INDICE + COINCIDIR.

Ejemplos de fórmulas de búsqueda para una tabla como la de la siguiente imagen:

Ubicamos en celda M2 un número de documento:  F-104

Para obtener el nombre   =BUSCARV($M$2;D:F;3;FALSO)

Para obtener el importe  =BUSCARV(M2;D3:H18;5;FALSO)

Para obtener la fecha      =INDICE(C:C;COINCIDIR($M$2;D:D;0))

Para obtener el Id.Reg   =INDICE(B3:B17;COINCIDIR(M2;D3:D17;0))

Notas: los signos $ solo serán necesarios si arrastramos la fórmula. La búsqueda puede realizarse en columnas completas (D:F) siempre y cuando no haya otras tablas o datos más allá de este rango.

En el caso de que nuestra hoja tenga Diseño de Tabla, no necesitamos seleccionar columnas o rangos de datos, sino simplemente hacer mención al nombre de la columna.

Para obtener el nombre   =BUSCARV(M2;Tabla1[[NRO.DOC.]:[NOMBRE]];3;FALSO)

Para obtener la fecha      =INDICE(Tabla1[FECHA];COINCIDIR($M$2;Tabla1[NRO.DOC.];0))

Nota: a pesar de ser Tabla, de todos modos podemos utilizar las fórmulas anteriores. Pero justamente tenemos que aprovechar las ventajas de no tener que seleccionar rangos sino utilizar los títulos de columnas.

Y si de VBA se trata, estas 2 macros nos resuelven el problema de modo sencillo:

Sub busqueda_Gral()

'devolviendo datos a la derecha del código buscado

dato = [M2]

Set busco = Range("D:D").Find(dato, LookAt:=xlWhole)

If Not busco Is Nothing Then   

    [O4] = Range("F" & busco.Row)       'indicando la col a devolver

    [O7] = busco.Offset(0, 4)                    'moviéndonos 4 col a derecha

End If

End Sub

 

Sub busqueda_Tabla()

'devolviendo datos a la izquierda del código buscado, en un diseño de Tabla

dato = [M2]

Set busco = Range("Tabla1[[NRO.DOC.]]").Find(dato, LookAt:=xlWhole)

If Not busco Is Nothing Then

    [P4] = Range("C" & busco.Row)      'indicando la col a devolver

    [P7] = busco.Offset(0, -2)                  'moviéndonos 2 col a la izquierda 

End If

End Sub

 

IMPORTANTE: las fórmulas con las funciones INDICE + COINCIDIR también pueden ser utilizadas para obtener información a la derecha del dato buscado.

Para descargar el libro de ejemplo, entrar aquí.

Para ver video 54 entrar aquí.