☰

根据不同的参数获取不同的计数

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 worksheet-function vba
根据不同的参数获取不同的计数

我需要根据几个参数获取不同计数（唯一值出现的次数）。表格如下所示：

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

获取金额不是问题，我使用带有几个参数的 SUMIFS()。我的问题在于获取 Distinct Count。

User-ID 不是数字，而是文本。Item
-ID 是数字。Amount
是数字。Date
是日期。

答案1

我找到了一个使用 VBA 的解决方案。以下是感兴趣的人的代码：

注意：我已经很多年没用过 VBA 了，所以我的代码可能不太好。欢迎提出任何修改建议。

首先我从命名单元格中获取开始日期和结束日期

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

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

然后我从命名单元格中获取 Item-Id 并将其转换为字符串

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

然后我设置 Sheet，获取最后一行，定义 Filterarea 和 Unique 行

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)

然后我调用下面的函数根据我的参数对其进行过滤并返回唯一计数并将其写入另一个命名单元格

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

相关内容