VBA - 按属性过滤用户定义类的集合/字典的最有效方法

Question

我的问题是关于根据属性字段过滤 vba 集合或字典。我使用 VBA 来处理一堆数据提取，并为此目的提供了一系列自定义的类对象。一旦定义了它们并将它们填充到集合或字典中，我需要根据各种属性选择这些对象的子集。我的问题是，是否有比简单循环并测试条件更有效的方法？

下面是一些基本代码来说明问题。由于我的工作场所政策，我什至无法上传示例 Excel 文件，但数据并不真正相关。我的测试文件只是一堆 rand Between 函数，例如 '=choose(rand Between(1,3),"red","green","blue")

'Simple Class definition
Option Explicit
'very simple test class
'One field is unique, the other three are simple strings that 
'fall into    groups (I don't always know what the groups will bee)

Private m_uniqueID As String
Private m_strTest1 As String
Private m_strTest2 As String
Private m_strTest3 As String

Public Property Get uniqueID() As String: uniqueID = m_uniqueID: End Property
Public Property Let uniqueID(ByVal NewValue As String): m_uniqueID = NewValue: End Property
Public Property Get strTest1() As String: strTest1 = m_strTest1: End Property
Public Property Let strTest1(ByVal NewValue As String): m_strTest1 = NewValue: End Property
Public Property Get strTest2() As String: strTest2 = m_strTest2: End Property
Public Property Let strTest2(ByVal NewValue As String): m_strTest2 = NewValue: End Property
Public Property Get strTest3() As String: strTest3 = m_strTest3: End Property
Public Property Let strTest3(ByVal NewValue As String): m_strTest3 =   NewValue: End Property

我的基本过滤方法：

Public Sub inefficientFilter()
    Dim oTest As cl_Test
    Dim colTest As Collection
    'assume it's populated

    Dim colMatches As Collection
    Set colMatches = New Collection

    For Each oTest In colTest
        If oTest.strTest1 = "Green" Then
            colMatches.Add Item:=oTest, Key:=oTest.uniqueID
        End If
    Next oTest
End Sub

这工作得很好，只是执行时间增长得相当快（现在 100,000 行最多需要 17 秒）。我已经尝试寻找解决此问题的方法一段时间了，并且发现了很多有关过滤源表的参考资料。但是，这对于我的数据集来说并不实用，因为数据在读入后经过大量处理，并且我需要过滤的一些属性未在输入中定义。而且，我需要根据许多不同的属性来过滤它，其中一些我事先不知道（我的意思是我知道一个字段将包含类别，但我不知道这些类别是什么，直到数据已处理，它们可能会随着下一个数据集而改变）。

如果没有一种比循环更有效地选择的字典或集合的方法，那么我计划创建一个大型过滤器函数，为每个分类字段创建一个集合，这样我至少可以避免每次循环我需要应用一个过滤器并一次性处理这一切。或者，将哈希表的某些内容写入单个 Excel 工作表，然后使用 adodb.recordset 查询来查找匹配项（我还没有进行足够的测试来知道哪个开销较小）。然而，在我去那里之前，我想我应该问一下我是否遗漏了一些明显的东西。

谢谢！

-添加12/15

Mat Mug 的第一条评论提到迭代字典的键数组，并建议使用 for...next 循环。所以我去修改我的代码来测试不同迭代方法的时间。我想我应该分享结果。我测试了7种方法，还有下面蒂姆·威廉的回答。我认为只总结一下而不详细说明代码是可以的，因为它非常微不足道。如果我错了，我可以轻松添加。我在 10,000 个项目上运行了这个（因为如果我运行到 300k，有两种方法会导致我的计算机自杀）。因此，这是结果，以及完成循环的持续时间（以秒为单位）（每个循环迭代集合或字典，然后测试给定条件的每个项目，如果匹配，则将该项目添加到结果中收藏）：

1. 0.00578 For every Loop，循环遍历集合（对于 col 中的每个 o）
2. 0.20099 对于 Next Loop，使用计数器作为集合的索引，然后通过 SET obj = col(i) 检索项目
3. 0.27605 对于下一个循环，与 2 相同但跳过 SET。
   所以测试条件是 if col(i).strtest1 = "Green" then ...)
4. 现在是 0.01275 字典。对于 dict.keys 中的每个键，SET obj = dict(key)
5. 0.02605 对于 dict 中除 SET 之外的每个键，与 3 一样，测试条件为 dict(key).strtest1 = "Green" then ...)
6. 3.68905 对于带有索引的 Next，对于 dict.count i = 1，设置 o = dict(i)
7. 4.16361 与 6 相同，但没有 SET dict.items(i).strTest1 = "Green" 那么...
8. 0.02192 还有下面蒂姆·威廉的回答

所以从这里我了解到永远不要用索引迭代字典。此外，当直接处理对象（使用 SET）时，VBA 比通过对集合或字典的引用进行访问要快得多。最快的方法是简单的 FOR EACH obj IN Collection, NEXT obj 循环。简单地迭代字典（FOR EACH key IN dict.keys, SET obj = dict(key), NEXT key）需要两倍多的时间（这是有道理的，因为每个循环上都有一个额外的操作，即 SET 函数） 。尽管每个循环的成本都是固定的，所以如果您在循环期间执行多个操作（测试多个条件），那么这将变得不那么重要。而William先生的方法与foreach key方法相当。

好的，考虑到我刚刚重新运行了迭代匹配函数的测试（模拟我不仅进行过滤，而且处理过滤后的选择的情况）。因此，如果我的标头失败，这应该读取为方法编号、方法完成 1 场比赛操作所用的时间、每个方法比 1 场比赛的最快方法花费的时间的因素、方法完成 50 场比赛所用的时间操作，比基线长多少的因素。

方法__1x(s)因子(1x)__50x(s)_____因子(50x) 1_______0.006____1_________0.159_________1__循环每个集合2___0.201___35_________0.336_____2__下一个索引为3___0.276___48________19.165_____120 #2 跳过SET 4______每个键_0.013____2_____0.159____1__在字典 5_______0.026____5_____5.560__35__#4 中跳过 SET 6___3.689__369_________3.851___24__ 对于下一个索引为 7___4.164__721___211.929____1333__#6 的字典，跳过 SET 8________0.022____4_____0.144________1__先生。威廉的回答

所以这强化了上面的答案。随着复杂性的增加，方程上的 for-each 循环，或 dict.keys 中的每个键，set obj=dict(key) 以及 William 先生的答案都同样有效。使用索引的影响会随着访问属性的次数而减少，但它的效率低于使用 foreach 方法。最后，当您直接访问类对象时，VBA 的效率要高得多，而不是通过父集合/字典的引用来访问它。也许这对除了我之外的每个人来说都是显而易见的，因为我没有编程背景并且正在学习，但是对我的直觉和经验法则进行一些量化是很好的。

我意识到此时我已经模糊了三个不同的问题。最快的过滤方法、最快的迭代方法以及访问集合或字典中对象的属性的最快方法。抱歉，如果这太遥远了，我只是想分享我从阅读您的答案中学到的东西。

Answer 1

使用您的示例类对 300k 对象进行了测试。

编辑：更新了更多的过滤灵活性。

Dim data As Object

Sub Tester()

    Dim colF As Collection
    Dim arr, o As Class1, n As Long, t, k, o2 As Variant

    arr = Array("Red", "Green", "Blue")
    Set data = CreateObject("scripting.dictionary")

    'load up some test data
    t = Timer
    For n = 1 To 300000#
        Set o = New Class1
        o.uniqueID = "ID" & Format(n, "000000000")
        o.strTest1 = arr(Int((2 - 0 + 1) * Rnd + 0))
        o.strTest2 = arr(Int((2 - 0 + 1) * Rnd + 0))
        o.strTest3 = arr(Int((2 - 0 + 1) * Rnd + 0))
        data.Add o.uniqueID, o
    Next n
    Debug.Print "Loaded", Timer - t

    'do some filtering
    t = Timer
    Debug.Print "filtered", Filtered("strTest1", "Red").Count, Timer - t
    t = Timer
    Debug.Print "filtered", Filtered("strTest2", "Green").Count, Timer - t
    t = Timer
    Debug.Print "filtered", Filtered("strTest3", "Blue").Count, Timer - t

End Sub

'generic filtering on named property+value
Function Filtered(propName As String, propValue As String) As Collection
    Dim rv As New Collection, o As Variant
    For Each o In data.items
        If CallByName(o, propName, VbGet) = propValue Then rv.Add o.uniqueID
    Next o
    Set Filtered = rv
End Function

输出：

Loaded                       6.601563 
filtered       100006        0.7109375 
filtered       99936         0.828125 
filtered       100144        0.9609375 

创建对象是缓慢的部分：过滤相当快。

如果您的真实类只是字段的集合，那么使用自定义类型而不是类可能会获得更好的性能。无论哪种方式，如果您仍然遇到问题，最好更新您的问题，以包含您需要快速处理的事情类型的完整示例。