Contar único VBA

Esta función permite contar valores únicos de un rango, con una condición de otro rango. Sería algo parecido a la funcion contar.si, pero el resultado final son valores únicos.

=ContarUnico([1];[2];[3])

[1]: Rango de valores que queremos contar sin repetidos

[2]: Rango que tienen las condiciones

[3]: Condición

Captura

Public Function ContarUnico(rng As Range) As Long
   'abelorteu@informaticaea.com
 
    Dim col As New Collection
    Dim cel As Range
    On Error Resume Next
    For Each cel In rng
        col.Add Item:=CStr(cel.Value), Key:=CStr(cel.Value)
    Next cel
    ContarUnico = col.Count
End Function
 
Public Function ContarUnicoSi(Unico As Range, Range1 As Range, Valor As Variant) As Long
       '=ContarUnicoSi([1];[2];[3])
       '[1]: Rango de valores que queremos contar sin repetidos
       '[2]: Rango que tienen las condiciones
       '[3]: Condición
 
       'abelorteu@informaticaea.com
    Dim filaInit As Long
    Dim filaFinal As Long
 
    Dim col As New Collection
 
    filaInit = Range1.Row
    filaFinal = filaInit + Range1.Rows.Count - 1
 
    On Error Resume Next
    For i = 1 To filaFinal - filaInit + 1
        If (UCase(Trim(Range1(i).Value)) = UCase(Trim(Valor))) Then
            col.Add Item:=CStr(Unico(i).Value), Key:=CStr(Unico(i).Value)
        End If
    Next
 
    If (arrDic.Count = 0) Then
        ContarUnicoSi = col.Count
    Else
        ContarUnicoSi = col.Count - 1
    End If
End Function
 
Public Function ContarUnicoSiConjunto(Unico As Range, ParamArray prms() As Variant) As Variant
    '=ContarUnicoSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos contar sin repetidos
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
 
    Dim col As New Collection
 
    filaInit = Unico.Row
    filaFinal = filaInit + Unico.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    If (x = Int(x)) Then
        On Error Resume Next
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If (Condicion) Then
                col.Add Item:=CStr(Unico(i)), Key:=CStr(Unico(i))
                Debug.Print Unico(i)
            End If
        Next i
 
        If (arrDic.Count = 0) Then
            ContarUnicoSiConjunto = col.Count
        Else
            ContarUnicoSiConjunto = col.Count - 1
        End If
    Else
       ContarUnicoSiConjunto = "#ERROR"
    End If
End Function

2 thoughts on “Contar único VBA

  1. Sebastian Reply

    Me funciono perfecto, solo en ContarSiConjunto tuve que reemplazas los
    por

    y funcionó

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *