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

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

下面是一些基本的代码来说明问题。 由于我的工作环境政策，我甚至无法上载Excel示例文件，但这些数据并不相关。 我的testing文件只是一堆函数之间的rand，如'= choose（randbetween（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 

这工作正常，只是执行时间增长得相当迅速（现在最多17万10万行）。 我试着search一个这样的方法一段时间，我发现过滤源表的很多参考。 但是，这对于我的数据集来说并不实用，因为数据在读入后大量处理，而且我需要过滤的一些属性在input中没有定义。 而且，我还需要对它进行过滤，其中一些我不会事先知道（我的意思是我知道一个字段将包含类别，但我不知道这些类别是什么数据被处理，并且可能随着下一个数据集而改变）。

如果没有一种方法来过滤比循环更有效的字典或集合，比我计划创build一个大的filter函数，为每个分类字段创build一个集合，这样我至less可以避免每次循环我需要应用一个filter，并一口气处理它。 或者，也可以把一个hashtable的东西写出来放在一个excel表单里，而我们adodb.recordset查询来查找匹配（我还没有testing过，知道哪个开销less）。 但是，在我去之前，我想我会问我是否错过了一些明显的东西。

谢谢！

– join12/15

Mat Mug的第一个注释提到迭代字典的键盘数组，并build议使用for … next循环。 所以我去修改我的代码来testing迭代的不同方法的时间。 我以为我应该分享结果。 我testing了7种方法，以及Tim William的答案如下。 我认为没有详细说明代码就可以总结一下，因为它非常简单。 如果我错了，我可以很容易地添加它。 我在10000个项目上跑了这个（因为有两个方法导致我的电脑自杀，如果我去了300K）。 所以这里是结果，完成循环的时间以秒为单位（每个循环遍历集合或字典，然后testing给定条件的每个项目，如果匹配，则将该项目添加到结果采集）：

1. 0.00578对于每个循环，通过集合循环（对于col中的每个循环）
2. 0.20099对于Next Loop，使用计数器作为集合的索引，然后通过SET obj = col（i）检索一个项目，
3. 0.27605对于Next Loop，与2相同，但跳过SET。
   所以testing条件是如果col（i）.strtest1 =“绿色”那么…）
4. 现在是0.01275字典。 对于dict.keys中的每个键，SET obj = dict（key）
5. 0.02605对于除了SET以外的字典中的每个键，如3，testing条件是字典（键）.strtest1 =“绿色”，然后…）
6. 3.68905对于下一个索引，对于i = 1到dict.count，设置o = dict（i）
7. 4.16361相同但没有SET dict.items（i）.strTest1 =“绿色”，然后…
8. 0.02192以及Tim William的答案在下面

因此，我从来没有学过一个索引字典。 此外，直接处理对象（使用SET）比通过引用集合或字典访问VBA要快得多。 最快的方法是一个简单的FOR EACH obj IN Collection，NEXT obj循环。 简单地迭代一个字典（对于每个关键字IN dict.keys，SET obj = dict（key），NEXT key）需要一点点的时间（这是有道理的，因为每个循环都有一个额外的操作，SET函数） 。 虽然每个循环的税收都是固定的，但是如果你在循环过程中进行多个操作（testing多个条件），这个variables就不那么重要了。 威廉先生的方法是可比的每个关键的方法。

好吧，我只是重新运行testing迭代匹配函数（模拟一种情况，我不只是过滤，但处理过滤的select）。 因此，如果我的头文件失败，这应该读为方法编号，完成1匹配操作的方法已用完的时间，每个方法所花费的时间比1个匹配的最快方法花费的时间，方法完成50次匹配所花费的时间操作，比基线多长的因素。

方法_1x（s） 因子（1x）__ 50x（s）_____因子（50x）1 _______ 0.006 ____ 1 _________ 0.159 _______ 1_loop for each each collection 2 _______ 0.201 ___ 35 _________ 0.336 _______ 2__ for next with a index 3 _______ 0.276 ___ 48 ________ 19.165 _____ 120 ＃2 skipping SET 4 _______ 0.013 ____ 2 _________ 0.159 _______ 1__ for each key in dict 5 _______ 0.026 ____ 5 _________ 5.560 ______ 35 __＃4 skipping SET 6 _______ 3.689__369 _________ 3.851 ______ 24__ for next next word with index 7 _______ 4.164__721 _______ 211.929 ____ 1333 __＃6跳过SET 8 _______ 0.022 ____ 4 _________ 0.144 _______ 1__Mr。 威廉的回答

所以这强化了上面的答案。 一个方程上的每个循环，或者一个dict.keys中的每个键，设置obj = dict（key），威廉先生的答案与复杂性增长的效率相似。 使用索引的影响随访问属性的次数而减less，但效率低于使用每种方法的效率。 最后，当你直接访问一个类对象时，VBA更有效率，而不是通过从父集合/字典中引用来访问它。 也许这对除我以外的每个人都是显而易见的，因为我没有编程背景，并且随时都在学习，但是对我的直觉和经验法则进行量化是很好的。

我意识到我在这个问题上模糊了3个不同的问题。 最快的方法来过滤，最快的方式来进行迭代，以及访问集合或字典中的对象的属性的最快方法。 对不起，如果这太远了，我只想分享我从阅读中学到的东西。

Answer 1

使用您的示例类来testing300k个对象。

编辑 ：更新一点过滤灵活性。

 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 

创build对象是很慢的部分：过滤非常快。

如果你真正的类只是一个字段的集合，那么你可能会得到更好的性能使用自定义types，而不是一个类。 无论哪种方式，如果你仍然有问题，最好是更新你的问题，包括一个你需要快速工作的事情types的完整的例子。

Answer 2

另一个select是创build一个字典词典来pipe理对象。 在初始实例化之后，在检索对象方面将没有多less开销。

这个方法花了大约50％的时间来装载@TimWilliams的例子，但是对象的索引是基于他们4个属性的值，而不是Tim的演示中的1个属性。

类：clTest_Collection

 Public dictAll As Object Public dicStr1 As Object Public dicStr2 As Object Public dicStr3 As Object Public Sub Add(uniqueID As String, str1 As String, str2 As String, str3 As String) Dim obj As cl_Test Set obj = New cl_Test With obj .uniqueID = uniqueID .strTest1 = str1 .strTest2 = str1 .strTest3 = str1 End With dictAll.Add obj.uniqueID, obj AddToDictionary dicStr1, obj, str1 AddToDictionary dicStr2, obj, str2 AddToDictionary dicStr3, obj, str3 End Sub Private Sub AddToDictionary(ByRef dict As Object, ByRef obj As cl_Test, ByRef value As String) If Not dict.Exists(value) Then dict.Add value, CreateObject("Scripting.Dictionary") dict(value).Add obj.uniqueID, obj End Sub Private Sub Class_Initialize() Set dictAll = CreateObject("Scripting.Dictionary") Set dicStr1 = CreateObject("Scripting.Dictionary") Set dicStr2 = CreateObject("Scripting.Dictionary") Set dicStr3 = CreateObject("Scripting.Dictionary") End Sub 

Module1：公共模块

 Sub Test() Dim t As Single, x As Long Dim ObjCollection As clTest_Collection Set ObjCollection = New clTest_Collection t = Timer For x = 1 To 300000 ObjCollection.Add "Item" & x, getRndColor, getRndColor, getRndColor Next Debug.Print "Total Time in Seconds: "; Timer - t End Sub Function getRndColor() As String getRndColor = Choose(Int(Rnd * 3) + 1, "Red", "Green", "Blue") End Function