excel - 有没有办法在 VBA 中自动创建字典？

Question

我在下面包含的代码段将 Excel 表中的数据放入字典中，其中表的第一列是文件名（键），第二列是文件的路径。代码工作得很好，但是我想用其他几个表来做这个，创建一堆具有不同文件名和位置的字典，用于不同的目的。

目前我分别创建这些字典，它们都在自己的小子中。这当然意味着我有多个版本的几乎相同的代码：非常麻烦。

我的问题是我不知道如何创建动态数量的变量来容纳我的表格。很确定那甚至是不可能的。我会很感激一些关于我可以研究的建议，什么大方向值得探索。

Sub locationsObject()

Dim locationTable As ListObject
Dim lrow As Range
Set locationTable = ActiveSheet.ListObjects("locationTable")
Set Locations = CreateObject("Scripting.Dictionary")

'Create dictionary with locations and their names from the location table. Check if locations are valid
For Each lrow In locationTable.ListColumns(1).DataBodyRange.rows
    Locations(lrow.Value) = lrow.Offset(0, 1).Value
    'Debug.Print Locations(lrow.Value)
    'Debug.Print lrow.Value
    checkIfExists Locations(lrow.Value), "The path of " & lrow.Value & " does not exist: " & Locations(lrow.Value) & vbCrLf & "Please provide a valid path."
Next lrow

End Sub

标签： excelvbadictionary

Answer 1

创建一个通用函数，将 ListObject 连同 Key 和 Item 列名称或索引一起传递给该函数。返回字典

像这样的东西

• 创建新字典，或附加到现有字典
• 可选地传递Key和Item列名或索引。默认为第 1 列的键和第 2 列的项目
• 包括错误处理的大纲，您可以根据自己的需要进行充实
• 这被写为早期绑定。如果您愿意，它很容易适应后期装订

Function CreatDictionaryFromList( _
  lo As ListObject, _
  Optional Dic As Dictionary, _
  Optional Key As Variant = 1, _
  Optional Item As Variant = 2) _
As Dictionary 'Late Binding use As Object, and Optional Dic As Object

    Dim Keys As Variant, Items As Variant
    Dim idx As Long
    
    If Dic Is Nothing Then
        ' Early Binding
        Set Dic = New Dictionary
        ' Late Binding
        ' Set Dic = CreateObject("Scripting.Dictionary")
    End If
    
    On Error GoTo EH_InvalidListObject
    Keys = lo.ListColumns(Key).DataBodyRange.Value2
    Items = lo.ListColumns(Item).DataBodyRange.Value2
    
    On Error GoTo EH_InvalidKey
    For idx = LBound(Keys, 1) To UBound(Keys, 1)
        If Not Dic.Exists(Keys(idx, 1)) Then
            Dic.Add Keys(idx, 1), Items(idx, 1)
        ' Else
        ' Duplicate key.  What now?
        End If
    Next
    
    Set CreatDictionaryFromList = Dic
Exit Function
EH_InvalidListObject:
    ' ListObject is Nothing, or Table column name doesn't exist.  What now?
    Set CreatDictionaryFromList = Nothing
Exit Function
EH_InvalidKey:
    ' Invalid Key.  What now?
    Resume Next
End Function

你可以这样称呼

Sub Demo()
    Dim Locations As Dictionary
    Dim lo As ListObject
    
    Set lo = ActiveSheet.ListObjects("locationTable")
    Set Locations = CreatDictionaryFromList(lo, , 1, 2)
    ' or
    ' Set Locations = CreatDictionaryFromList(lo, ,"NameOfKeyColumn", "NameOfItemColumn)
    Set lo = ActiveSheet.ListObjects("AnotherTable")
    Set Locations = CreatDictionaryFromList(lo, Locations, 1, 2)
    
    Dim i As Long
    For i = 0 To Locations.Count - 1
        Debug.Print Locations.Keys(i), Locations.Items(i)
    Next

End Sub