3 Macros básicas que todos deben tener.

Como ya hemos dicho y tratamos que sea una base sobre lo que representa este blog, automatizar es una de las cosas que siempre debemos buscar en Excel. Si bien las fórmulas ya hacen tareas por nosotros, a veces esto se reduce a repetir fórmulas hasta el cansancio, y esto nos regresa al primer punto en donde no estamos realmente optimizando nuestra forma de trabajar.

Luego tenemos los macros, que son una de las bases para realmente empezar a automatizar. Gracias a herramientas como VBA es que podemos acercarnos más al espectro de la programación sin que sea un requisito el ser experto en lenguajes de programación. Pero lejos de ahondar en temas complejos o macros muy específicos, es bueno regresar a lo básico y visitar macros que nos pueden ahorrar hasta horas de trabajo.

Estos 3 macros básicas que vamos a ver son bastante simples en naturaleza, pero útiles, pues son ese punto intermedio entre hacer tareas completamente manuales y funciones específicas, por lo que nos serán útiles en un rango importante de tareas con las que podremos encontrarnos en el día a día.

1. CONTAR EL NÚMERO DE CELDAS CON UN COLOR ESPECÍFICO USANDO VBA

En el apartado de FORMULAS de Excel, tenemos «Más funciones» y luego la categoría de «Estadísticas». Ahí tenemos una función llamada COUNTIF, la cual cuenta el número de celdas dentro de un rango que cumpla cierta condición. Estos criterios por sí mismos están limitados a texto o números, pero si usamos VBA podemos crear una función para contar el número de celdas con otro criterio, como lo puede ser el color de celda.

Si usamos VBA, podemos crear y guardar un UDF («Función definida por el usuario» en inglés) como un complemento para poder usarlo en otros libros de trabajo e incluso transferirlo a otros equipos.

Para insertar el siguiente código insertaremos un nuevo módulo en VBA. Si no recuerdas como puedes revisarlo aqui

Function ConCeldaColor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long

xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
   If datax.Interior.ColorIndex = xcolor Then ConCeldaColor = ConCeldaColor + 1
Next datax

End Function

Para poder probar nuestro UDF, usaremos un conjunto de datos de ejemplo que contengan un número de columnas de celdas de diferentes colores.

Y después, solo usaremos la función.

=ConCeldaColor(B2:B11,F1)

En el argumento «range_data» seleccionaremos las celdas B2 a la B11, y en el argumento «criteria» seleccionaremos la celda F1.

Esta misma función puede trabajar con colores de letras, solo bastara con cambiar el parámetro Interior.ColorIndex por Font.ColorIndex

Function ConLetraColor(range_data As Range, criteria As Range) As Long

Dim datax As Range
Dim xcolor As Long

xcolor = criteria.Font.ColorIndex
For Each datax In range_data
   If datax.Font.ColorIndex = xcolor Then ConCeldaColor = ConCeldaColor + 1
Next datax

End Function

2. BORRAR OBJETOS DUPLICADOS EN UNA LISTA DE EXCEL

Aquí veremos dos muestras. Para estos macros necesitaremos estar un poco familiarizados con el lenguaje de programación y las herramientras que se muestran para poder hacer debug y ajustar a nuestras necesidades si es que hace falta.

En el primer ejemplo veremos cómo eliminar objetos duplicados en una sola lista. Con este macro buscaremos una sola lista en el rango A1:A100 y se borrarán todos los duplicados que haya en esa lista. Este macro requiere que no tengamos celdas vacías dentro del rango que elijamos. De tenerlos, tendremos que acomodar nuestros datos en orden ascendente para que las celdas vacías estén al final de nuestra lista.

Sub BorrarDup_OneList()
    Dim iListCount As Integer
    Dim iCtr As Integer
    
    ' Turn off screen updating to speed up macro.
    Application.ScreenUpdating = False
    
    ' Get count of records to search through.
    iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
    Sheets("Sheet1").Range("A1").Select
    ' Loop until end of records.
    Do Until ActiveCell = ""
       ' Loop through records.
       For iCtr = 1 To iListCount
          ' Don't compare against yourself.
          ' To specify a different column, change 1 to the column number.
          If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
             ' Do comparison of next record.
             If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
                ' If match is true then delete row.
                Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
                   ' Increment counter to account for deleted row.
                   iCtr = iCtr + 1
             End If
          End If
       Next iCtr
       ' Go to next record.
       ActiveCell.Offset(1, 0).Select
    Loop
    Application.ScreenUpdating = True
    MsgBox "Yey!"
End Sub

Y para nuestro segundo ejemplo, usaremos un macro que comparará dos listas y eliminará los objetos que estén repetidos en ambas. Funciona de la siguiente forma: se compara una lista (master) con otra lista y borrará los objetos duplicados en la segunda lista que también se encuentren en nuestra lista master. La primera lista se encuentra en Hoja1 en el rango A1:A10, mientras que la segunda lista está en Hoja2 en el rango A1:A100. Para ejecutar el macro, seleccionaremos cualquiera de las dos hojas e introduciremos lo siguiente:

Sub BorrarDup_TwoLists()
    Dim iListCount As Integer
    Dim iCtr As Integer
    
    ' Turn off screen updating to speed up macro.
    Application.ScreenUpdating = False
    
    ' Get count of records to search through (list that will be deleted).
    iListCount = Sheets("sheet2").Range("A1:A100").Rows.Count
    
    ' Loop through the "master" list.
    For Each x In Sheets("Sheet1").Range("A1:A10")
       ' Loop through all records in the second list.
       For iCtr = 1 To iListCount
          ' Do comparison of next record.
          ' To specify a different column, change 1 to the column number.
          If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
             ' If match is true then delete row.
             Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
             ' Increment counter to account for deleted row.
             iCtr = iCtr + 1
          End If
       Next iCtr
    Next
    Application.ScreenUpdating = True
    MsgBox "Yey!"
End Sub

3. CONVERTIR NÚMEROS A PALABRAS

Por defecto, Excel no cuenta con una función que nos muestre números como palabras en una hoja de cálculo, pero podemos hacerlo posible si pegamos la siguiente función de código SpellNumber en un módulo de VBA. Con esta función podremos convertir cantidades de dinero a palabras, por lo que 22.50 será leído como «veintidos pesos con cincuenta centavos». Esto nos puede resultar bastante útil si usamos Excel como una plantilla para imprimir cheques, por ejemplo.

Si quieres convertir valores numéricos a un formato de texto sin mostrarlo como palabras, podemos usar la función TEXT en su lugar.

Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count

ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

' String representation of amount.
MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")

' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
    Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1

Do While MyNumber <> ""
    Temp = GetHundreds(Right(MyNumber, 3))
    If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
    If Len(MyNumber) > 3 Then
        MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
        MyNumber = ""
    End If
    Count = Count + 1
Loop

Select Case Dollars
    Case ""
        Dollars = "No Dollars"
    Case "One"
        Dollars = "One Dollar"
    Case Else
        Dollars = Dollars & " Dollars"
End Select

Select Case Cents
    Case ""
        Cents = " and No Cents"
    Case "One"
        Cents = " and One Cent"
    Case Else
        Cents = " and " & Cents & " Cents"
End Select

SpellNumber = Dollars & Cents
End Function


' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String

If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
    
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
    Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & GetTens(Mid(MyNumber, 2))
Else
    Result = Result & GetDigit(Mid(MyNumber, 3))
End If

GetHundreds = Result
End Function


' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String

Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
    Select Case Val(TensText)
        Case 10: Result = "Ten"
        Case 11: Result = "Eleven"
        Case 12: Result = "Twelve"
        Case 13: Result = "Thirteen"
        Case 14: Result = "Fourteen"
        Case 15: Result = "Fifteen"
        Case 16: Result = "Sixteen"
        Case 17: Result = "Seventeen"
        Case 18: Result = "Eighteen"
        Case 19: Result = "Nineteen"
        Case Else
    End Select
Else ' If value between 20-99...
    Select Case Val(Left(TensText, 1))
        Case 2: Result = "Twenty "
        Case 3: Result = "Thirty "
        Case 4: Result = "Forty "
        Case 5: Result = "Fifty "
        Case 6: Result = "Sixty "
        Case 7: Result = "Seventy "
        Case 8: Result = "Eighty "
        Case 9: Result = "Ninety "
        Case Else
    End Select
    Result = Result & GetDigit _
    (Right(TensText, 1)) ' Retrieve ones place.
End If

GetTns = Result

End Function


' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
    Case 1: GetDigit = "One"
    Case 2: GetDigit = "Two"
    Case 3: GetDigit = "Three"
    Case 4: GetDigit = "Four"
    Case 5: GetDigit = "Five"
    Case 6: GetDigit = "Six"
    Case 7: GetDigit = "Seven"
    Case 8: GetDigit = "Eight"
    Case 9: GetDigit = "Nine"
    Case Else: GetDigit = ""
End Select
End Function

Y para reutilizar mis UDF…

Otra cosa que podemos hacer es comprimir el UDF para que la función pueda ser usada en otro libro de trabajo o en otra computadora. Para ello, habrá que ir a «Archivo» y «Guardar como» (seleccionaremos «Explorar» si hace falta). Elegiremos «Complemento de Excel» como nuestro formato y le daremos un nombre.

Ahora solo necesitamos instalarlo. Para ello abriremos Excel en el equipo en donde queramos instalar el complemento. Abriremos la ventana de diálogo de complementos yendo a Complementos de Excel.

Iremos a la ubicación en donde hayamos guardado nuestro complemento, elegiremos el archivo y le daremos en «Abrir». De vuelta en la ventana de «Complementos», nos aseguraremos de que nuestro complemento esté marcado con palomita y daremos OK.

Si quieres instalar sin esfuerzo estas 3 Macros básicas puedes descargarlas aquí.

Tener estas 3 macros básicas en mente te ayudara a realizar algunas tareas de manera sencilla. Y si se te olvidan siempre puedes regresar a buscarlas aquí.

Cualquier duda nos leemos abajo.