COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

Hola a todos!:

Estos días estoy más liado de lo normal!, de repente se ha vuelto todo muchas … Intenso!. En fin, hay temporadas más tranquilas y otras con más trabajo, así es la vida.

Pero no por eso voy a dejar de publicar el post semanal de Excel y VBA, verdad?. Esta temporada estoy subiendo muchos vídeos de ejemplo de mis post a LinkedIn para que los usuarios de la red vean cómo funciona realmente un procedimiento o una fórmula.

Hoy quiero compartir una de tantas formas que existen para crear y colocar encabezados en nuestros informes. Desde la igualación de celdas a un valor a un proceso  mediante un loop o igualando un rango a un array.

Este último ejemplo es el que vamos a ver hoy, y es muy sencillo: Imaginad que queréis mostrar siempre este encabezado en la hoja que se esté activa:

COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

Para conseguirlo, lo vamos a hacer con 5 líneas de código:

Sub ENCABEZADOS()
With Range("A1:F1")
.Value = Array("NOMBRE", "APELLIDOS", "EDAD", "ESTUDIOS", "TELÉFONO", "DIRECCIÓN")
.Font.Bold = True
.Font.Color = vbRed
End With
End Sub

Como podéis ver,  no hemos usado una sola variable, simplemente hemos definido el rango y lo igualamos al Array que hemos creado con los nombres que queremos usar como encabezados, la coma es el separador entre los distintos elementos del array.

Para colorear las letras, usamos la propiedad font.color y usando una constante para darle color rojo.

Para dar formato negrita, pasamos propiedad Bold como true.

Ya se que es un post cortito, pero para los que no conocéis este método, estoy seguro que os seré de utilidad en algún momento.

Descarga el archivo de ejemplo pulsando en: COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

GENERAR PALETA DE COLORES CON VBA

Hola a todos:

El post de hoy es sobre la paleta de colores que usa Excel y como podemos listar esos colores utilizando VBA.

Para empezar, me gustaría decir que este tema está muy publicado en internet, en particular hay una macro que se encuentra en muchas webs sobre esta temática, ¡¡la misma macro!! lo que indica la nula creatividad de algunos autores a la hora de realizar los post y copiar el código directamente sin molestarse en cambiar ni una línea. Yo plantearé otra forma.

Os mostraré un procedimiento que listará todos los colores de esa paleta, del 1 al 56, el cero no lo tendremos en cuenta, dado que es idéntico al 2 (blanco).

Lo haremos en horizontal y cada 6 celdas, de forma que se verá como una paleta de colores y no una fila hacia abajo …

Lo haremos con este código:

Option Explicit
Sub PALETA_COLOR()
'Definimos variables
Dim CONT As Integer, COL As Integer
Dim i As Integer
'Inicializamos proceso
CONT = 1
COL = 1
'Creamos loop para colorear celda con cada color index
'Cada 6 celdas seguimos el loop en la columna siguiente
For i = 1 To 56
If CONT <= 5 Then
Cells(CONT, COL).Interior.ColorIndex = i
Cells(CONT, COL + 1).Value = "Color: " & i
CONT = CONT + 1
Else
Cells(CONT, COL).Interior.ColorIndex = i
Cells(CONT, COL + 1).Value = "Color: " & i
CONT = 1
COL = COL + 2
End If
Next i
End Sub

La ejecución del código se realiza con un botón de comando y también he añadido otra sencilla macro para limpiar el rango:

Sub LIMP()
Dim CELDA As Variant
'Limpiamos datos en rango
With ActiveSheet
For Each CELDA In .Range("A1:T6")
CELDA.Clear
Next CELDA
End With
End Sub

Este es el resultado de ejecutar nuestro código:

GENERAR PALETA DE COLORES CON VBA

Si quisiéramos seguir con el loop en la columna siguiente cada 15 celdas, por ejemplo, solo tendríamos que cambiar el número en esta línea de código:

If CONT <= 5 Then

a

If CONT <= 14 Then

Como véis es una macro muy sencilla y visual, y también podéis comprobar como se pueden exponer temas muy tratados en las webs especializadas sobre vba y excel y ser un poco original a la par de evitar el copiar códigos ajenos : ).

Descarga el archivo de ejemplo pulsando en: GENERAR PALETA DE COLORES CON VBA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

CREAR CADENA ALFANUMÉRICA SIN DUPLICADOS CON UNA FUNCIÓN

Hola a todos:

Hoy me gustaría tratar otra vez el tema de las cadenas alfanuméricas sin duplicados, es decir con caracteres únicos, no repetidos.

Esto es un tema que ya he publicado varias veces en esta web, en concreto hoy voy a tratar sobre este post: GENERAR CADENA DE CARACTERES ALFANUMÉRICOS ALEATORIOS SIN DUPLICADOS

A nivel teórico no vamos a crear nada nuevo, pero sí a nivel práctico, dado que vamos a pasar el proceso que en el post os mostraba con una macro (y su botón de ejecución) a ser realizado con una función.

Podéis consultar la macro accediendo al post que os he dejado y aquí os voy a dejar el mismo código pero modificado para ser una función:

Option Explicit
Function CADENA_UNICOS(ByVal LARGO As Long, MIN As Long, MAX As Long)
'Declaramos variables
Dim oDic As Object
Dim Micelda As String, matrix1 As Variant, matrix2 As Variant
Dim sCadena As String, i As Long, unicos As String
Dim j As Long, nNum As Double
Dim nLetU As String, nLetL As String, nItem As Variant, nCombo As Integer
With Sheets("Hoja1")
'Creamos objeto diccionario
Set oDic = CreateObject("scripting.dictionary")
'Ejecutamos loop hasta el total de números y letras que queremos obtener
Do Until j = LARGO
'generamos aleatorios entre lo que indiquemos
nNum = Application.WorksheetFunction.RandBetween(MIN, MAX)
'generamos aleatorio de letras mayúsculas
nLetU = Chr((Application.WorksheetFunction.RandBetween(65, 90)))
'generamos aleatorio de letras minúsculas
nLetL = LCase(Chr((Application.WorksheetFunction.RandBetween(65, 90))))
'determinamos aleatoriamente qué elemento seleccionamos para pasar a la cadena
nCombo = Application.WorksheetFunction.RandBetween(1, 3)
If nCombo = 1 Then
nItem = nNum
ElseIf nCombo = 2 Then
nItem = nLetU
ElseIf nCombo = 3 Then
nItem = nLetL
End If
'componemos string con los números y letras que vamos generando
Micelda = Micelda & " " & nItem
matrix1 = Split(Micelda, " ")
'Eliminamos números y letras repetidos
For i = 0 To UBound(matrix1)
If Not oDic.Exists(matrix1(i)) Then oDic.Add matrix1(i), matrix1(i)
Next i
'Creamos una nueva cadena sin duplicados y seguimos el loop
unicos = Join(oDic.Keys, " ")
sCadena = Trim(unicos)
matrix2 = Split(sCadena, " ")
'contamos los números y letras aleatorios únicos que vamos generando
j = UBound(matrix2) + 1
Loop
'Pasamos los datos a la función
CADENA_UNICOS = sCadena
End With
'Vaciamos variable de objeto
Set oDic = Nothing
End Function

Es prácticamente igual a la macro, pero hay que tener en cuenta los parámetros, que ahora los vamos a seleccionar directamente desde la función.

Sus parámetros son (sin comillas):

LARGO: es la longitud que deseamos dar a nuestra cadena.
MIN y MAX: se trata del rango mínimo y máximo con el que se generará la función aleatorio.entre.

En este caso, queremos un largo de 10 caracteres (no cuentan los blancos),  y números entre el 1 y el 9:

CREAR CADENA ALFANUMÉRICA SIN DUPLICADOS CON UNA FUNCIÓN

Y de esta forma tenemos el resultado de la función en una celda y según lo especificado.

Un dato importante, si el número que indicamos en el argumento “LARGO” es mucho mayor a MAX, es posible que la función no responda, dado que se puede producir que estemos buscando una cadena de números aleatorios más alta de los que podemos generar según los parámetros.

Por ejemplo, si estuviésemos trabajando solo con una cadena numérica y especificásemos un largo de 10 y usar números de 1 a 9, la aplicación se bloqueará en un bucle sin fin. En esta macro, esto no se produce con esa claridad, dado que introducimos letras, y por lo tanto no se puede realizar un control. Por ello, tratad de indicar el argumento MAX mayor que LARGO.

Los números o caracteres aleatorios están separados por un espacio, que no se cuenta pero sirve como separador.

Como siempre, os dejo el ejemplo:

Descarga el archivo de ejemplo pulsando en: CREAR CADENA ALFANUMÉRICA SIN DUPLICADOS CON UNA FUNCIÓN

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA

Hola a todos:

Como podéis comprobar, estos últimos post que estoy subiendo a la web están muy relacionados con las UDF (funciones definidas por el usuario). Y es que precisamente el poder definir nuestras propias funciones es lo que nos permite realizar nuestro trabajo con mayor facilidad.

Muchas veces recibo consultas de cómo hacer determinados procesos o cómo programar un evento específico. Hoy os dejo un ejemplo de una de esas consultas:

“Hola Segu. Tengo una tabla de datos la cual consta de varias columnas con diferentes marcas, y en las filas tengo códigos únicos, lo que deseo hacer es que de alguna manera colocar el código único en una celda fuera de la tabla, y que me retorne la o las marcas que tiene ese código, es decir en donde la función encuentre el número uno, entonces colocar el nombre de la marca que se encuentra en el encabezado.”

Efectivamente, lo que vamos a realizar se puede ver perfectamente en el ejemplo que me envió:

EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA

Como podéis comprobar, se trata de rellenar el dato en las celdas B7,B8 y B9 con las “Marcas” de la fila 1 siempre que el código tenga un “1” asignado en rango horizontal.

Para poder hacerlo tal y como lo necesita el lector, usaremos la siguiente UDF:

Option Explicit
Function BUSCA_REF(ByVal DATO_BUSCADO As Variant, RANGO_BUSQUEDA As Range, RANGO_HORIZONTAL As Range, PARAMETRO As String)
'Declaramos variables
Dim HOJA As String, CELDAV As Object, CELDAH As Object, CELDA_ACTUAL As String, RANGO_ACTUAL As Range
Dim FILA As String, nCOLUMN As String, DATO As String, CONT As Long
'Capturamos la hoja en la que se encuentra el rango de búsqueda
HOJA = RANGO_BUSQUEDA.Parent.Name
'Buscamos el dato seleccionado en el rango de búsqueda
For Each CELDAV In RANGO_BUSQUEDA
'Si coincide entonces
If UCase(CELDAV) = UCase(DATO_BUSCADO) Then
'obtenemos el número de celda en el que nos encontramos
CELDA_ACTUAL = Replace(Split(CELDAV.Address, "$")(2), ":", "")
'Componemos nuevo rango horizontal a buscar
Set RANGO_ACTUAL = Sheets(HOJA).Range(Replace(Split(RANGO_HORIZONTAL.Address, "$")(1), ":", "") & CELDA_ACTUAL & ":" & Replace(Split(RANGO_HORIZONTAL.Address, "$")(3), ":", "") & CELDA_ACTUAL)
'Buscamos en el rango horizontal
For Each CELDAH In RANGO_ACTUAL
'Si encontramos el valor igual al parámetro (en este ejemplo "1")
If CELDAH = PARAMETRO Then
'Seleccionamos el encabezado de la hoja
'compuesto por el número de fila y letra de columna actual
FILA = Replace(Split(RANGO_HORIZONTAL.Address, "$")(2), ":", "")
nCOLUMN = Replace(Split(CELDAH.Address, "$")(1), ":", "")
DATO = DATO & " " & Sheets(HOJA).Range(nCOLUMN & FILA)
End If
Next CELDAH
CONT = CONT + 1
End If
Next CELDAV
'Pasamos resultado a la función
'si el valor buscado no existe pasamos un error
If CONT = 0 Then
BUSCA_REF = "#N/A"
Else
'si existe pero no tiene el parámetro buscado pasamos un 0, sino el dato
BUSCA_REF = IIf(DATO = vbNullString, 0, DATO)
End If
End Function

Como siempre el código lo he comentado muy detalladamente para que no tengáis dudas. Por supuesto, este trabajo lo podemos hacer también con código en una macro sin utilizar una función, pero el lector prefería que fuese una UDF.

La función está habilitada para funcionar en distintas hojas y se actualiza con cada cambio.

Los parámetros a tener en cuenta son:

  • El DATO_BUSCADO: el dato que queremos buscar en la matriz.
  • El RANGO_BUSQUEDA: el rango vertical en el que se encuentra el código a buscar.
  • El RANGO_HORIZONTAL: es la selección de todo el rango, tanto encabezados como las celdas con información.
  • PARÁMETRO: es el parámetro sobre el que basamos la búsqueda, por ejemplo “1”. Entre comillas dobles.

Aquí podéis ver la fórmula aplicada:

EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA_1

Y esto es todo, aquí podéis ver el ejemplo de cómo creando nuestra propia función podemos obtener lo que necesitamos.

Descarga el archivo de ejemplo pulsando en: EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

FUNCIÓN PARA ELIMINAR TILDES EN CELDA SELECCIONADA

Hola a todos!.

¿Qué tal estáis?, espero que bien.

Hoy voy a publicar una función muy sencilla que nos va a ayudar a eliminar las tildes de las palabras que hayamos seleccionado.

Cuando cruzamos datos, en muchas ocasiones tenemos problemas a la hora de determinar coincidencias cuando en una palabra tenemos una tilde y en otra no.

Para solucionar este problema acabo de crear una función, se llamará SIN_TILDES.

Este es el código que utilizaremos:

Function SIN_TILDE(ByVal Rango As String)
'Reemplazamos tildes en vocales minúsculas
Rango = Replace(Rango, "á", "a")
Rango = Replace(Rango, "é", "e")
Rango = Replace(Rango, "í", "i")
Rango = Replace(Rango, "ó", "o")
Rango = Replace(Rango, "ú", "u")
'Reemplazamos tildes en vocales mayúsculas
Rango = Replace(Rango, "Á", "A")
Rango = Replace(Rango, "É", "E")
Rango = Replace(Rango, "Í", "I")
Rango = Replace(Rango, "Ó", "O")
Rango = Replace(Rango, "Ú", "U")
SIN_TILDE = Rango
End Function

Como podéis observar, es muy sencilla y básicamente programamos la función Replace() para poder eliminar las tildes en las palabras.

Por ejemplo:

FUNCIÓN PARA ELIMINAR TILDES EN CELDA SELECCIONADA

No hay mucho más que explicar … obviamente, la podéis combinar con buscarv y otras funciones.

Y esto es todo, espero que os sea de utilidad.

Descarga el archivo de ejemplo pulsando en: FUNCIÓN PARA ELIMINAR TILDES EN CELDA SELECCIONADA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

UDF BUSCARZ. BÚSQUEDA A LA IZQUIERDA Y MOSTRAR TODAS LAS COINCIDENCIAS. PARTE I

Hola a todos!!

¿Qué tal estáis?, espero que bien y que hayáis descansado en vuestras vacaciones. Hoy retomo las publicaciones de la web y estoy seguro que la de hoy os va a resultar muy interesante.

Hace unas semanas se publicó en todos las redes la aparición de una nueva función de búsqueda: “BUSCARX“. Esta función viene a dar solución a muchas de las carencias que tenía la fórmula BUSCARV y también ampliar funcionalidades. Esta nueva fórmula no estará disponible para todos hasta el año que viene y eso es lo que me ha hecho reflexionar sobre las carencias actuales de BUSCARV y todo lo que podemos hacer nosotros, como usuarios de VBA para encontrar soluciones.

Por lo tanto, he creado una nueva función que he denominado BUSCARZ y en la que podremos hacer lo siguiente:

  • Buscar valores a la izquierda de la matriz.
  • Mostrar el primer valor encontrado desde “arriba hacia abajo” (descendente).
  • Mostrar el primer valor encontrado desde “abajo hacia arriba” (ascendente).
  • Mostrar todas las coincidencias en una búsqueda.

Os presento el código de la función:

Option Explicit
Function BUSCARZ(ByVal DATO_BUSCADO As Variant, RANGO_BUSQUEDA As Range, COLUMNA As String, TIPO_BUSQUEDA As Integer)
'Declaramos variables
Dim nCOLUMN As String, nCELDA As String, CELDA As Variant
Dim VALOR_INICIAL As String, VALOR_FINAL As String
Dim VALOR_TOTAL As String, TODOS As String, HOJA As String
'capturamos hoja en la que se buscan datos
HOJA = RANGO_BUSQUEDA.Parent.Name
'Indicamos letra de la columna
nCOLUMN = COLUMNA
'nCOLUMN = Replace(Split(COLUMNA.Address, "$")(1), ":", "")
'Por cada celda en el rango seleccionado de búsqueda
For Each CELDA In RANGO_BUSQUEDA
'Si la celda no igual al dato seleccionado entonces indicamos #N/A
If UCase(CELDA) <> UCase(DATO_BUSCADO) Then BUSCARZ = "#N/A"
'Si la celda es igual al dato seleccionado entonces
If UCase(CELDA) Like UCase(DATO_BUSCADO) Then
'Obtenemos numero de la celda en el que estamos
nCELDA = Split(CELDA.Address, "$")(2)
'Si el tipo de búsqueda no es 2 o 3, entonces obtenemos el primer valor encontrado
'buscando de forma descendente
If TIPO_BUSQUEDA > 3 Or TIPO_BUSQUEDA <= 1 Then
VALOR_INICIAL = Sheets(HOJA).Range(nCOLUMN & nCELDA)
'Pasamos el valor a la función
BUSCARZ = VALOR_INICIAL
Exit For
End If
'Obtenemos el valor final
VALOR_FINAL = Sheets(HOJA).Range(nCOLUMN & nCELDA)
'obtenemos string con todos los valores encontrados
TODOS = Trim(TODOS & "|" & VALOR_FINAL)
VALOR_TOTAL = Mid(TODOS, 2, Len(TODOS))
End If
'Pasamos los valores a la función
If TIPO_BUSQUEDA = 2 Then
BUSCARZ = VALOR_FINAL
ElseIf TIPO_BUSQUEDA = 3 Then
BUSCARZ = VALOR_TOTAL
End If
Next CELDA
End Function

La sintaxis de la función es la siguiente:

  • DATO_BUSCADO: Es el valor que vamos a buscar. Podemos hacer referencia o indicar el valor entre comillas dobles ” “.
  • RANGO_BUSQUEDA: Es el rango sobre el que buscamos los datos.
  • COLUMNA: Determina la columna sobre la que vamos a extraer la información.
  • TIPO_BUSQUEDA: a elegir sobre tres tipos:
    • 1 – Mostrar el primer valor encontrado desde “arriba hacia abajo” (descendente).
    • 2 – Mostrar el primer valor encontrado desde “abajo hacia arriba” (ascendente).
    • 3 – Mostrar todas las coincidencias en una búsqueda. Entre cada resultado se añade una barra vertical.

Llegados a este punto, creo que lo interesante será hacer un ejemplo. Empezaremos con una búsqueda de tipo 1 y de datos a la izquierda, traemos información de la columna “A”.

UDF BUSCARZ. REALIZAR BUSQUEDAS A LA DERECHA Y ENCONTRAR TODAS LAS COINCIDENCIAS. PARTE I

Búsqueda de tipo 2 y de datos a la izquierda, traemos información de la columna “A”.

UDF BUSCARZ. REALIZAR BUSQUEDAS A LA DERECHA Y ENCONTRAR TODAS LAS COINCIDENCIAS. PARTE I_1

Búsqueda de tipo 3 y de datos a la izquierda, traemos información agrupada de la columna “A”.

UDF BUSCARZ. REALIZAR BUSQUEDAS A LA DERECHA Y ENCONTRAR TODAS LAS COINCIDENCIAS. PARTE I_2

La función también permite buscar en otras páginas y otros libros.

Nota: esta función la he programado en unas pocas horas. Si notáis que algo no funciona correctamente, por favor, pasadme feed.

Aunque son algunas mejoras interesantes, tengo pensado añadir y ampliar nuevas funcionalidades, así que iré actualizando el post en distintas publicaciones.

Ahora os dejo el archivo de prueba como siempre.

Descarga el archivo de ejemplo pulsando en: UDF BUSCARZ. BÚSQUEDA A LA IZQUIERDA Y MOSTRAR TODAS LAS COINCIDENCIAS. PARTE I

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

FUNCIÓN PARA CONTAR VALORES ÚNICOS EN UN RANGO

Hola a todos:

Como estoy a punto de comenzar las vacaciones (ya casi puedo oler el mar), hoy voy a escribir un post para despedirme hasta dentro de unos días.

Para el post de hoy voy a utilizar una consulta de un lector como planteamiento:

Sería posible una UDF que permitiera contar distintos. Es decir, una fórmula similar a SUMAR.SI.CONJUNTO pero que contara solo el valor único y no repetidos. Por si no me he explicado del todo bien, las nuevas tablas dinámicas (vinculadas a un modelo de datos) permiten el “recuento distinto”, sería replicar esa posibilidad en una UDF.

Realmente (creo), que lo que se busca es una función que cuente los valores únicos en un rango seleccionado, o lo que es lo mismo, los valores distintos.

Para realizar este ejercicio, lo voy a hacer con datos numéricos, aunque nuestro código siempre tratará la información como un texto, dado que trabajaremos con “string” o cadenas de texto.

Vamos con un ejemplo:

FUNCION PARA CONTAR VALORES UNICOS EN UN RANGO

Aquí tenemos una relación de números no repetidos del 1 al 45, en cada celda un número. Es decir que los valores únicos en este caso son “45”.

Para obtener este dato vamos a utilizar una función que acabo de crear y que llamaré: “CONTARUNICOS”

Este es el código:

Function CONTARUNICOS(ByVal target As Range)
'Declaramos variables
Dim Cuenta As Long, matriz As Variant
Dim Dato As String, celda As Variant
Dim i As Long, oDic As Object
Dim Unicos As String
'Recorremos todas las celdas incluidas en el rango
For Each celda In target
Dato = Dato & " " & celda
Next celda
'Creamos una matriz con la cadena anterior
matriz = Split(Dato, " ")
'Creamos objeto diccionario para seleccionar solo únicos
Set oDic = CreateObject("scripting.dictionary")
For i = 0 To UBound(matriz)
If Not oDic.Exists(matriz(i)) Then oDic.Add matriz(i), matriz(i)
Next i
'Una vez que tenemos string de únicos, contamos espacios en blanco +1
Unicos = Trim(Join(oDic.Keys, " "))
Cuenta = UBound(Split(Unicos, " ")) + 1
'Pasamos el valor a la función
CONTARUNICOS = Cuenta
End Function

Así, el resultado de la función es:

FUNCION PARA CONTAR VALORES UNICOS EN UN RANGO_1

Si tuviésemos, por ejemplo, la columna D con números del 1 al 45, el resultado sería el mismo:

FUNCION PARA CONTAR VALORES UNICOS EN UN RANGO_2

Si incluimos nuevos datos, que no estén repetidos, la función los contará.

Y eso es todo, espero que con esta función haya respondido la duda del lector y os sirva también en vuestros proyectos.

PD: Nos vemos a la vuelta de las vacaciones : )

Descarga el archivo de ejemplo pulsando en: FUNCIÓN PARA CONTAR VALORES ÚNICOS EN UN RANGO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies