VBA擅长找到集合的统计模式

Question

所以我试图在Excel中分析一些数据，并且在查找最频繁的数字时遇到一些麻烦。我的位置数量不明，可能有不明数量的捐款。例如

• Brantford $ 50.00
• Brantford $ 25.00
• Brantford $ 50.00
• Windsor $ 200.00
• 魁北克$ 25.00
• 魁北克省100.00美元
• 魁北克省$ 50.00
• 魁北克省$ 50.00
• 魁北克$ 25.00
• 魁北克省$ 50.00
• 魁北克省$ 50.00
• 魁北克$ 25.00
• 魁北克省100.00美元
• 魁北克省$ 40.00
• Windsor $ 140.00
• Windsor $ 20.00
• Windsor $ 20.00

所以我需要使用VBA为每个位置找到计数，总和，平均值和模式（必须通过VBA完成，不能只使用高级过滤器/数据透视表编写如何执行此操作的说明:(）

所以现在使用VBA我有一个字典对象，它将位置名称存储为密钥，并将每个捐赠存储在集合中。使用我有计数的集合的计数，可以轻松地循环收集总和，使用我有平均值;但是，我不确定获得模式的最有效方法。

我知道如果我的数据在使用Application.mode的数组中，我可以找到它，但这似乎不适用于集合:(。将集合转换为数组虽然找到模式但实际上并不是打击我是最有效的解决方案。但我能找到的其他选项是对集合进行排序然后循环遍历它们以找到模式。

所以想知道是否有人知道找到集合统计模式的好方法？

Dim locdata As Object
Set locdata = CreateObject("scripting.dictionary")  

For counter = 2 To max
    mykey = Cells(counter, loccol).value
    If Not (locdata.exists(mykey)) Then
        locdata.Add (mykey), New Collection
    End If
    locdata(mykey).Add (Cells(counter, donamountcol).value)
Next counter
For Each k In locdata.keys
    locname = k
    Cells(counter, 1) = k
    Cells(counter, 2) = locdata(k).Count
    donationtotal = 0
    For Each donvalue In locdata(k)
        donationtotal = donationtotal + donvalue
    Next donvalue
    Cells(counter, 3) = donationtotal
    Cells(counter, 4) = donationtotal / CDbl(locdata(k).Count)
    'Cells(counter, 5) = Application.mode(locdata(k)) doesn't work :(
    counter = counter + 1
Next k

编辑：理想情况下输出应该是（以魁北克为例） 魁北克省：数量：10总和：515平均值：51.5模式：50

Answer 1

以下是如何动态地将范围中的值转换为aarray。我会在VBA中使用 CountIF 来查找名称最常见的对象。因为您不知道location names或{{1然后，数组就是最佳选择。

donations

更新：下面的Dim ar as Variant Dim endRow as Long 'get last row in the range endRow = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row 'ar = WorksheetFunction.Transpose(Shets(1).Range("A1:A12") 'using endrow ar = WorksheetFunction.Transpose(Shets(1).Range("A1").resize(endRow).value) 使用一次迭代（for循环）来查找subroutine ..

Mode

输出：

Answer 2

我过去遇到过类似的情况。在我看来，excel中缺少一个非常强大的VBA函数 - 相当于MySQL中的“where”语句 所以我自己写了一个非常简单的...它缺乏很多功能，但它可以让你做你想要的，同时最大限度地减少你编写的代码量。
基本概念：您可以从函数调用返回一个数组，Excel内置函数可以像在函数上一样在这样的数组上运行。因此，如果您的函数返回“我想要模式的所有数字”，那么=MODE(myfunction())将为您提供所需的答案。
我选择调用我的函数subset(criteria, range1, range2)。
在最简单的形式中，它返回range2中的元素，这些元素对应于range1中符合条件的元素。 这没有经过广泛测试，但我希望你能得到这个想法 顺便说一下，你可以在多个单元格中输入这个数组公式（shift-ctrl-enter）;在这种情况下，你得到第一个单元格中的第一个返回元素，等等。当你有一个需要返回多个值的函数（例如一个范围）时，这是一个有用的技巧 - 但是对于这种情况你只需要结果提供给另一个功能。

Option Explicit
' Function subset(criteria, range1, range2)
' Return an array with the elements in range2 that correspond to
' elements in range1 that match "criteria"
' where "criteria" can be a string, or a value with a < = > sign in front of it

' example: =subset("bravo", A1:A10, B1:B10)
' returns all cells from B that corresponds to cells in A with "bravo"
' =subset("<10", A1:A10, B1:B10) returns all cells in B corresponding to
' cells in A with a value < 10
' This is analogous to the "where" function in SQL, but much more primitive

Function subset(criteria As String, range1 As Range, range2 As Range)
Dim c
Dim result
Dim ii, jj As Integer
On Error GoTo etrap

If range1.Cells.Count <> range2.Cells.Count Then Exit Function
ReDim result(1 To range1.Cells.Count)
ii = 1
jj = 1
For Each c In range1.Cells
If compare(c.Value, criteria) = 0 Then
  result(ii) = range2.Cells(jj).Value
  ii = ii + 1
End If
jj = jj + 1
Next c

If ii > 1 Then
ReDim Preserve result(1 To ii - 1)
subset = result
Else
subset = Nothing
End If

Exit Function
etrap:
MsgBox "Error " & Err.Description
End Function

Private Function compare(a, b)
' type of a decides what kind of comparison we do
If TypeName(a) <> TypeName("hello") Then
' use numerical comparison
compare = Not (Evaluate(a & b))
Else
' use string comparison
compare = StrComp(a, b, vbTextCompare)
End If
End Function

Answer 3

我其实刚刚决定制作字典词典。所以我有位置和每个位置，而不是每个捐赠金额的字典。很容易比较那种找到模式的方法。