FUNCIONES PERSONALIZADAS

 

Página inicial

 

 

En esta página hay algunas funciones personalizadas que realizan tareas no contempladas por las funciones estándar de Excel. En primer lugar vamos a ver tres funciones que usan el color de las celdas para realizar un conteo, una suma y un ordenamiento.

 

 

Una función de búsqueda:

 

Funciones varias:

 

Función ContarColorFondo

Esta función sirve para contar las celdas que tienen un determinado color de fondo en un rango:

Function ContarColorFondo(rngCeldaColor As Range, rngRangoAContar As Range) As Long
    Dim rngCelda As Range

    For Each rngCelda In rngRangoAContar
        If rngCelda.Interior.ColorIndex = rngCeldaColor.Cells(1, 1).Interior.ColorIndex Then ContarColorFondo = ContarColorFondo + 1
    Next rngCelda

    Set rngCelda = Nothing
End Function

La sintaxis es:

 

=ContarColorFondo(CeldaDeMuestra; RangoAContar)

 

donde CeldaDeMuestra es una sola celda que tiene el color que se desea procesar, y RangoAContar es el rango de celdas sobre el que se efectuará el recuento.

Esta función se usa normalmente en una celda cuyo color de fondo es el que se necesita contar.

 

Ejemplo:

 

=ContarColorFondo(C1;A1:A50)

 

devolverá el número de celdas en el rango A1:A50 cuyo color de fondo sea igual al de la celda C1.

 

Hay que tener en cuenta que esta función no es capaz de procesar el color de las celdas generado por los formatos condicionales. En este libro de ejemplo (Excel 2003) se usan algunas funciones personalizadas para sumar y contar las celdas de un determinado color, estando generado dicho color por un formato condicional. Para Excel 2007-2010 el enlace es este.

 

Nota sobre esta función: el cambio de color en una o más celdas usando la opción “Formato” o el botón “Color de relleno” no produce un recálculo de la hoja, por lo que la función ContarColorFondo no se actualizará hasta el siguiente recálculo. Sin embargo, la actualización de la función sí se produce si se copia el formato de una de las celdas cuyo color se quiere contar y se hace un pegado especial de dicho formato en la celda que sirve como modelo a la función, o si se utiliza el botón 'Copiar formato' de la barra de herramientas 'Formato'.

 

Función SumarColorFondo

Esta función sirve para sumar las celdas que tienen un determinado color de fondo en un rango:

Function SumarColorFondo(rngCeldaColor As Range, rngRangoAsumar As Range) As Double
    Dim rngCelda As Range

    For Each rngCelda In rngRangoAsumar
        If rngCelda.Interior.ColorIndex = rngCeldaColor.Cells(1, 1).Interior.ColorIndex Then SumarColorFondo = SumarColorFondo + rngCelda
    Next rngCelda

    Set rngCelda = Nothing
End Function

La sintaxis es:

 

=SumarColorFondo(CeldaDeMuestra; RangoASumar)

 

donde CeldaDeMuestra es una sola celda que tiene el color que se desea procesar, y RangoASumar es el rango de celdas sobre el que se efectuará la suma.

Esta función se usa normalmente en una celda cuyo color de fondo es el que se necesita sumar.

 

Ejemplo:

 

=SumarColorFondo(C1;A1:A50)

 

devolverá la suma de los valores de las celdas en el rango A1:A50 cuyo color de fondo sea igual al de la celda C1.

 

Hay que tener en cuenta que esta función no es capaz de procesar el color de las celdas generado por los formatos condicionales. En este libro de ejemplo (Excel 2003) se usan algunas funciones personalizadas para sumar y contar las celdas de un determinado color, estando generado dicho color por un formato condicional. Para Excel 2007-2010 el enlace es este.

 

Nota sobre esta función: el cambio de color en una o más celdas usando la opcíon “Formato” o el botón “Color de relleno” no produce un recálculo de la hoja, por lo que la función SumarColorFondo no se actualizará hasta el siguiente recálculo. Sin embargo, la actualización de la función sí se produce si se copia el formato de una de las celdas cuyo color se quiere sumar y se hace un pegado especial de dicho formato en la celda que sirve como modelo a la función, o si se utiliza el botón 'Copiar formato' de la barra de herramientas 'Formato'.

 

Función nColor

Se trata de una función muy sencilla que devuelve el código del color de la celda que se le pasa como argumento:

Function nColor(rngR As Range) As Long
    nColor = rngR.Cells(1, 1).Interior.ColorIndex
End Function

La sintaxis es:

 

=nColor(Celda)

 

donde Celda es una sola celda cuyo color de fondo se quiere averiguar (si se le pasa un rango como argumento, la función devolvera el código del color de la primera celda del rango).

 

Esta función debe ponerse en todas las celdas de una columna (o en todas las celdas de una fila si se quiere ordenar en horizontal) en el rango que se quiere ordenar por sus colores de fondo. La función devuelve el código de dichos colores, y entonces es posible ordenar el rango por la columna o fila que tiene la función.

 

Ejemplo: en el siguiente rango, se ha usado la función nColor en la columna COLOR y luego se ha ordenado el rango, primero por dicha columna y luego por la columna DATO:

 

 

 

Función BuscarEnVariosRangos

Excel tiene una función (BuscarV) para buscar un valor determinado en una columna de un rango y devolver un valor situado en la misma fila pero una o varias columnas hacia la derecha.

Esta función personalizada hace lo mismo pero en varios rangos, los cuales pueden estar situados en una misma hoja o en varias:

Function BuscarEnVariosRangos(ValorBuscado As Variant, btColumna As Single, blOrdenado As Boolean, ParamArray mtrR() As Variant) As Variant
    Dim iteradorR As Variant, Encontrado As Variant
          
    On Error GoTo NoEncontrado
    For Each iteradorR In mtrR()
              
        Encontrado = WorksheetFunction.VLookup(ValorBuscado, iteradorR, btColumna, blOrdenado)
        If Not IsEmpty(Encontrado) Then
            BuscarEnVariosRangos = Encontrado
            Exit Function
        End If
          
    Next iteradorR
          
    BuscarEnVariosRangos = "No encontrado."
          
    Exit Function
          
NoEncontrado:
    If Err.Number = 1004 Then
        Resume Next
    Else
        BuscarEnVariosRangos = Err.Description
    End If
         
End Function
 

La sintaxis es:

 

=BuscarEnVariosRangos(DatoBuscado; ColumnasHaciaLaDerecha; Ordenado; RangosEnQueSeBuscará)

 

Donde DatoBuscado es lo que se quiere buscar, bien sea un valor, un literal o una referencia a otra celda, y Ordenado es un valor booleano (VERDADERO o FALSO) que indica si los rangos están ordenados (si no se está seguro, lo mejor es poner siempre FALSO).

 

Ejemplo: en un libro hay dos hojas de cálculo (Hoja1 y Hoja2), cada una de las cuales tiene un listado de productos

 

 

  

Si se quisiera encontrar el producto cuyo código es C02 y devolver su precio (columna C) pero no se supiera en qué hoja podría estar el producto, se podría usar

 

=BuscarEnVariosRangos("C02";2;FALSO;Hoja1!A2:C4;Hoja2!A2:C4)

 

que devolvería 2,5

 

Funciones para encriptar y desencriptar una cadena de texto

[Libro de ejemplo]

Las siguientes funciones sirven para encriptar (o cifrar) y desencriptar (o descifrar) una cadena de texto en función de la clave facilitada.

Cuanto más larga sea la clave, más difícil será descubrirla, aunque no tiene ningún sentido que su longitud sea mayor que la del texto a encriptar.

La complejidad de la clave está determinada tanto por su longitud como por lo variada que sea. Por ejemplo, la clave “AAAAAAA” sería tan sencilla de descubir como “A”

 

Esta es la función para encriptar:

Public Function Encriptar(ByVal texto As String, ByVal clave As String) As String
    If Len(texto) = 0 Or Len(clave) = 0 Then
        Encriptar = "Error en la función Encriptar."
        Exit Function
    End If
          
    Dim posT As Integer, posC As Integer
    posC = 1
          
    For posT = 1 To Len(texto)
        Encriptar = Encriptar + Chr(IIf(Asc(Mid(texto, posT, 1)) + Asc(Mid(clave, posC, 1)) > 255, Asc(Mid(texto, posT, 1)) + Asc(Mid(clave, posC, 1)) - 255, Asc(Mid(texto, posT, 1)) + Asc(Mid(clave, posC, 1))))
        posC = IIf(posC = Len(clave), 1, posC + 1)
    Next posT
End Function

La sintaxis es:

 

=Encriptar(“Texto a encriptar”; “Clave”)

 

 

Y esta es la función para desencriptar:

Public Function Desencriptar(ByVal texto As String, ByVal clave As String) As String
    If Len(texto) = 0 Or Len(clave) = 0 Then
        Desencriptar = "Error en la función Desencriptar"
        Exit Function
    End If
          
    Dim posT As Integer, posC As Integer
    posC = 1
          
    For posT = 1 To Len(texto)
        Desencriptar = Desencriptar + Chr(IIf(Asc(Mid(texto, posT, 1)) - Asc(Mid(clave, posC, 1)) < 0, Asc(Mid(texto, posT, 1)) - Asc(Mid(clave, posC, 1)) + 255, Asc(Mid(texto, posT, 1)) - Asc(Mid(clave, posC, 1))))
        posC = IIf(posC = Len(clave), 1, posC + 1)
    Next posT
End Function

La sintaxis es:

 

=Desencriptar(“Texto a desencriptar”; “Clave”)

 

 

Si el sistema operativo es compatible con el juego de caracteres Unicode (Windows lo es pero, por ejemplo, Macintosh no), es posible añadir una segunda variable al proceso de cifrado: un modificador que variará la cantidad que se les resta a los códigos de los caracteres que conforman el texto en claro (lo que se quiere cifrar). De esta forma, no sólo será necesario conocer la clave para descifrar el criptograma (el texto cifrado), sino también su modificador, que al poder ser un número entre 1 y 32.767 añadirá alguna complicación a la hora de intentar descifrarlo si no se sabe cuál es dicho modificador.

 

El código de la función para cifrar es:

 

Public Function EncriptarU(ByVal texto As String, ByVal clave As String, Optional ByVal lModificador As Long) As String
    'Sintaxis: =EncriptarU(texto a encriptar, clave, modificador), donde modificador es un parámetro opcional, _
                que, de usarse, ha de ser un número entero >0 y <32768
    If lModificador < 0 Or lModificador > 32767 Then
        EncriptarU = "El modificador no puede ser <0 ni >32767"
        Exit Function
    End If
    If Len(texto) = 0 Or Len(clave) = 0 Then
        EncriptarU = "Error en la función EncriptarU."
        Exit Function
    End If
          
    Dim posT As Integer, posC As Integer
    posC = 1
          
    For posT = 1 To Len(texto)
        EncriptarU = EncriptarU + ChrW(IIf(AscW(Mid(texto, posT, 1)) + AscW(Mid(clave, posC, 1)) + lModificador > 32767, AscW(Mid(texto, posT, 1)) + AscW(Mid(clave, posC, 1)) + lModificador - 32767, AscW(Mid(texto, posT, 1)) + AscW(Mid(clave, posC, 1)) + lModificador))
        posC = IIf(posC = Len(clave), 1, posC + 1)
    Next posT
End Function

y el de la función para descifrar:

 

Public Function DesencriptarU(ByVal texto As String, ByVal clave As String, Optional ByVal lModificador As Long) As String
    'Sintaxis: =DesncriptarU(texto a encriptar, clave, modificador), donde modificador es un parámetro opcional, _
                que, de usarse, ha de ser un número entero >0 y <32768
    If lModificador < 0 Or lModificador > 32767 Then
        DesencriptarU = "El modificador no puede ser <0 ni >32767"
        Exit Function
    End If
    If Len(texto) = 0 Or Len(clave) = 0 Then
        DesencriptarU = "Error en la función DesencriptarU"
        Exit Function
    End If
          
    Dim posT As Integer, posC As Integer
    posC = 1
          
    For posT = 1 To Len(texto)
        DesencriptarU = DesencriptarU + ChrW(IIf(AscW(Mid(texto, posT, 1)) - AscW(Mid(clave, posC, 1)) - lModificador < 0, AscW(Mid(texto, posT, 1)) - AscW(Mid(clave, posC, 1)) - lModificador + 32767, AscW(Mid(texto, posT, 1)) - AscW(Mid(clave, posC, 1)) - lModificador))
        posC = IIf(posC = Len(clave), 1, posC + 1)
    Next posT
End Function

 

 

 

Página inicial