Scripting.Dictionary的性能选择

Question

我正在用Excel-VBA编写一个带有几个按钮的管理器。

null

• 销售商向许多客户销售许多产品

我正在生成一个新的Excel选项卡，其中包含上一个年/月的t数据，按销售商分组。

重要注意事项：

null

但我并不以此为荣，至少现在还没有。

我的代码主要基于scripting.dictionary从t映射数据，然后对obj中的每个键使用...next key将分组数据设置为新创建的选项卡。

我不确定，但以下是我的想法：

• 如果n是scripting.dictionary中的总键，并且在聚合total-money之前需要检查obj.exists(str)。它将运行n字符串比较返回false.
• 类似地，当我设置seller=obj(seller_name)
时，它将运行maximun n字符串比较。

我想让我的想法出错。但是如果我没有错的话，我的下一步（也是最后一个希望）是用tries编写我自己的类对象。

我只会明天开始编码，我想要的只是一些确认，如果我在正确的方式，或一些建议，如果我在错误的方式做它。

你有什么建议吗？提前谢了。

Answer 1

超过内存限制

简言之：

• 主要问题是因为我使用了存储信息（预处理）的动态编程方法来加快执行时间。
• 我的代码现在运行时间~13秒。

null

null

我用cls_trie实现创建了一个GitHub存储库，并添加了一个excel文件，并给出了使用示例。

我是excel-vba的新手（现在已经用了4个月了）。可能有一些方法可以改进我的cls_trie实现，我愿意接受建议：

Option Explicit

Public Keys As Collection
Public Children As Variant
Public IsLeaf As Boolean

Public tObject As Variant
Public tValue As Variant

Public Sub Init()
    Set Keys = New Collection
    ReDim Children(0 To 255) As cls_trie
    IsLeaf = False

    Set tObject = Nothing
    tValue = 0
End Sub

Public Function GetNodeAt(index As Integer) As cls_trie
    Set GetNodeAt = Children(index)
End Function

Public Sub CreateNodeAt(index As Integer)
    Set Children(index) = New cls_trie
    Children(index).Init
End Sub

'''
'Following function will retrieve node for a given key,
'creating a entire new branch if necessary
'''
Public Function GetNode(ByRef key As Variant) As cls_trie
    Dim node As cls_trie
    Dim b() As Byte
    Dim i As Integer
    Dim pos As Integer

    b = CStr(key)
    Set node = Me

    For i = 0 To UBound(b) Step 2
        pos = b(i) Mod 256

        If (node.GetNodeAt(pos) Is Nothing) Then
            node.CreateNodeAt pos
        End If

        Set node = node.GetNodeAt(pos)
    Next

    If (node.IsLeaf) Then
        'already existed
    Else
        node.IsLeaf = True
        Keys.Add key
    End If

    Set GetNode = node
End Function

'''
'Following function will get the value for a given key
'Creating the key if necessary
'''
Public Function GetValue(ByRef key As Variant) As Variant
    Dim node As cls_trie
    Set node = GetNode(key)
    GetValue = node.tValue
End Function

'''
'Following sub will set a value to a given key
'Creating the key if necessary
'''
Public Sub SetValue(ByRef key As Variant, value As Variant)
    Dim node As cls_trie
    Set node = GetNode(key)
    node.tValue = value
End Sub

'''
'Following sub will sum up a value for a given key
'Creating the key if necessary
'''
Public Sub SumValue(ByRef key As Variant, value As Variant)
    Dim node As cls_trie
    Set node = GetNode(key)
    node.tValue = node.tValue + value
End Sub

'''
'Following function will validate if given key exists
'''
Public Function Exists(ByRef key As Variant) As Boolean
    Dim node As cls_trie
    Dim b() As Byte
    Dim i As Integer

    b = CStr(key)
    Set node = Me

    For i = 0 To UBound(b) Step 2
        Set node = node.GetNodeAt(b(i) Mod 256)

        If (node Is Nothing) Then
            Exists = False
            Exit Function
        End If
    Next

    Exists = node.IsLeaf
End Function

'''
'Following function will get another Trie from given key
'Creating both key and trie if necessary
'''
Public Function GetTrie(ByRef key As Variant) As cls_trie
    Dim node As cls_trie
    Set node = GetNode(key)

    If (node.tObject Is Nothing) Then
        Set node.tObject = New cls_trie
        node.tObject.Init
    End If

    Set GetTrie = node.tObject
End Function

您可以在上面的代码中看到：

null

• 我可能永远不会更多地使用scripting.dictionary，即使事实证明它可能比我的cls_trie实现要好。

谢谢大家的帮助。