0

I need to get the distinct count (how many times does a unique value occur) based on a few parameters. The table looks similar to this:

http://i.imgur.com/kXNSyvH.png

Getting the Amount is not a problem, I use SUMIFS() with a few parameters. My problem is with getting the Distinct Count.

User-ID is not a Number, but a Text.
Item-ID is a Number.
Amount is a Number.
Date is a Date.

0hmu
  • 1

1 Answers1

0

I found a solution using VBA. Here is the Code for anyone interested:

Note: I haven't used VBA in years, so my Code might not be very good. Any Suggestions for Changes are more than welcome.

First I get the Startdate and and the Enddate from named Cells

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

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

Then I get the Item-Id also from a named Cell and convert it to a String

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

Then I set the Sheet, get the last Row, define the Filterarea and the Unique row

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)

Then I call the Function below to Filter it based on my Arguments and return the Unique Count and write it to another named Cell

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
0hmu
  • 1