VBA excel查找集合的统计模式

因此，我试图分析Excel中的一些数据，但在查找最常见的数字时遇到了一些困难。我有一个未知数量的地点，可以有一个未知数量的捐款。比如说

• 布兰特福德50.00美元
• 布兰特福德25.00美元
• 布兰特福德50.00美元
• 温莎200.00美元
• 魁北克25.00美元
• 魁北克100.00美元
• 魁北克50.00美元
• 魁北克50.00美元
• 魁北克25.00美元
• 魁北克50.00美元
• 魁北克50.00美元
• 魁北克25.00美元
• 魁北克100.00美元
• 魁北克40.00美元
• 温莎140.00美元
• 温莎20.00美元
• 温莎20.00美元

因此，我需要使用VBA来查找每个位置的计数、总和、平均值和模式（必须通过VBA完成，不能只是编写有关如何使用高级过滤器/透视表来完成此操作的说明：（））

因此，现在使用VBA，我有一个dictionary对象，它将位置名称存储为一个键，并将每个捐赠存储在一个集合中。使用集合的计数，我有计数，可以很容易地在集合中循环求和，使用我的平均值；但是，我不确定获取模式的最有效方法

我知道如果我的数据位于使用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

以下是如何将一个范围内的值动态输入aarray。我将在VBA中使用

按名称查找最常见的对象。因为您不知道

位置名称或
捐赠，所以ar雷是最好的选择

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循环）来查找
模式

Sub FrequencyByLocDonations()
Dim ar As Variant, dc As Object
Dim rngInput As Range, mxRng As Range
Dim endRow As Long, i As Integer
Dim counts As Double, maxLoc As Double
Dim maxLocation As String
   Set dc = CreateObject("Scripting.Dictionary")

   '-- When you know the range
   '   ar = WorksheetFunction.Transpose(Shets(1).Range("A1:A12").Value

    'get last row in the range when you don't know but the starting cell
    endRow = Sheets(3).Cells(Sheets(3).Rows.Count, "C").End(xlUp).Row
    Set rngInput = Sheets(3).Range("C2").Resize(endRow - 1, 1)

    '--you may also use that set rngInput as well
    '   WorksheetFunction.Transpose(rngInput).Value

    '-- using endrow-1 to not to take an extra blank row at the end
    ar = WorksheetFunction.Transpose(Sheets(3).Range("C2").Resize(endRow - 1, 2).Value)

    For i = LBound(ar, 2) To UBound(ar, 2)
        If Not (dc.exists(ar(1, i))) Then
            counts = Application.WorksheetFunction.CountIf(rngInput, ar(1, i))
            If counts >= maxLoc Then
                maxLocation = ar(1, i)
                maxLoc = counts
            End If
            dc.Add ar(1, i), counts
        End If
    Next i

    '-- output to the Sheet
    Sheets(3).Range("C2").Offset(0, 2).Resize(UBound(dc.keys) + 1, 1) = _ 
              Application.Transpose(dc.keys)
    Sheets(3).Range("C2").Offset(0, 3).Resize(UBound(dc.items) + 1, 1) = _
              Application.Transpose(dc.items)
    Sheets(3).Range("C2").Offset(0, 4) = "Most Frequent Location :" _ 
              & maxLocation & "; " & maxLoc

    Set dc = Nothing
End Sub

输出：

我过去也遇到过类似的情况。在我看来，excel中缺少了一个非常强大的VBA函数，相当于MySQL中的“where”语句。

因此，我自己编写了一个非常简单的程序……它缺少很多功能，但它可以让您完成自己的要求，同时最大限度地减少编写的代码量。

基本概念：您可以从函数调用返回数组，Excel内置函数可以像对函数一样对数组进行操作。因此，如果您有一个函数返回“我想要模式的所有数字”，那么
=mode（myfunction（））
将给出您想要的答案。

我选择调用我的函数
子集（条件，范围1，范围2）


它以最简单的形式返回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

选项显式
'函数子集（标准，范围1，范围2）
'返回一个数组，数组中的元素范围2与
'范围1中与“条件”匹配的元素'
'其中“条件”可以是字符串，也可以是前面带有<=>号的值
'示例：=子集（“好极了”，A1:A10，B1:B10）
'返回B中与A中带有“bravo”的单元格相对应的所有单元格
'=子集("实际上，我刚刚决定制作一本字典。因此，我有位置和每个位置，而不是每个捐赠金额的计数字典。通过这种方式比较计数很容易找到模式。
为什么不在字典中使用数组而不是集合？向集合中添加内容可能更容易，but数组更容易计算…我不知道需要分配多少值给数组您可以使用
ReDim Preserve myArray（newUpperBound）
在保留现有内容的同时扩展数组。请确保在更改数组之前将其从字典中取出：@Wizuriel此代码可能看起来更长。这主要是由于注释造成的。：）请试一试，随附的图片显示了
模式下的输出工作原理。不幸的是，我实际上在寻找每个位置的捐赠模式（查看我的数据，我应该选择更好的数字，因为没有一个有明确的模式）.使用countif是个好主意though@Wizuriel天哪！我现在读了你的问题；-）你能用对你的统计数据有意义的数字更新捐款栏吗？好消息是，这可以在我的代码中完成，只需几行代码就可以更改…我现在不在，如果我看到你的问题更新，我回来后会更新：-）另外，请根据您的样本数据分配预期结果集。在我看来，我需要学习更好地阅读问题…我想这并不能很好地满足您的需要。也许我的解决方案对某些人、某些地方仍然有用。例如，您可以使用我编写的代码创建所需元素的数组，然后使用applMo（）要得到你的答案。除非你的数据库是巨大的，否则它应该工作得很好。如果你的数据库实际上是巨大的，你应该考虑除Excel之外的其他东西。你可以找到一个例子来实现这个方法。