Obtenha uma contagem distinta com base em parâmetros diferentes

0

Eu preciso obter a contagem distinta (quantas vezes um valor único ocorre) com base em alguns parâmetros. A tabela é semelhante a esta:

Obtendo o valor não é um problema, eu uso o SUMIFS () com alguns parâmetros. Meu problema é obter a Contagem Distinta.

User-ID não é um número, mas um texto.
O ID do item é um número.
Montante é um número.
Data é uma data.

    
por 0hmu 06.06.2016 / 08:08

1 resposta

0

Eu encontrei uma solução usando o VBA. Aqui está o código para qualquer pessoa interessada:

Observação: eu não uso o VBA há anos, então meu código pode não ser muito bom. Quaisquer sugestões de alterações são mais que bem-vindas.

Primeiro eu recebo o Startdate e o Enddate de Células nomeadas

Dim MAnfang     As Long
MAnfang = Range("Monatsanfang").Value2

Dim MEnde       As Long
MEnde = Range("Monatsende").Value2

Então eu pego o Item-Id também de uma célula nomeada e o converto em uma String

Dim ItemID     As String
ItemID = CStr(Range("ItemID").Value)

Em seguida, defino a planilha, obtenho a última linha, defino a Filterarea e a linha exclusiva

Dim FSheet      As Worksheet
Set FSheet = Sheets("Faktura")

Dim k           As Integer
k = FSheet.Range("M1").End(xlDown).Row

Dim FBereich    As Range
Set FBereich = FSheet.Range("A1:X" & k)

Dim UniqueColRange As Range
Set UniqueColRange = FSheet.Range("T2:T" & k)

Em seguida, chamo a função abaixo para filtrá-lo com base em meus argumentos e retornar a contagem exclusiva e gravá-lo em outra célula nomeada

Range("Endresult").Value = FilterAndGetCount(FSheet, FBereich, 12, MAnfang, MEnde, 6, Array(ItemID), UniqueColRange )

End Sub

Private Function FilterAndGetCount(FilterSheet As Worksheet, FilterBereich As Range, DFeld As Integer, DStart As Long, DEnde As Long, LNFeld As Integer, LNArray As Variant, UniqueColumnRange As Range)

    FilterBereich.AutoFilter _
    Field:=DFeld, _
        Operator:=xlAnd, _
        Criteria1:=">=" & DStart, _
        Criteria2:="<=" & DEnde

    FilterBereich.AutoFilter _
        Field:=LNFeld, _
        Operator:=xlFilterValues, _
        Criteria1:=LNArray

    Total = getVisibleArray(UniqueColumnRange)
    FilterAndGetCount = getUniqueCount(Total) - 1
    If FilterSheet.AutoFilterMode Then FilterSheet.ShowAllData

End Function

Private Function getUniqueCount(varray As Variant) As Integer

    Dim dict As Object
    Set dict = CreateObject("scripting.dictionary")
    Dim element As Variant

    For Each element In varray
        If dict.exists(element) Then
            dict.Item(element) = dict.Item(element) + 1
        Else
            dict.Add element, 1
        End If
    Next

    getUniqueCount = dict.Count

End Function

Private Function getVisibleArray(vrange As Range) As Variant

    Dim i As Integer
    i = 0

    Dim VisibleArray() As Variant
    Dim VisibleArrayLength As Integer
    VisibleArrayLength = vrange.SpecialCells(xlCellTypeVisible).Count
    ReDim VisibleArray(VisibleArrayLength)

    For Each c In vrange.SpecialCells(xlCellTypeVisible)
        VisibleArray(i) = c.Value
        i = i + 1
    Next c

    getVisibleArray = VisibleArray

End Function
    
por 21.07.2016 / 10:59