VBA-excel词典

Question

我将单元格从一张表复制到另一张表，查找并匹配列标题名称并粘贴到正确的单元格。这些列标题名称在每张纸上略有不同，尽管它们包含相同的数据。我的工作代码有很多重复：

' sub that finds head in a specified worksheet and sets rngCol variable
Sub rngByHead(Sheet As Worksheet, head As String)
' sub for copying data
With Source1
     ' find and set producer, note name difference)
     Call rngByHead(Source1, "bedrijfsnaam")
     Dim producent As String
     producent = .Cells(docSource1.Row, rngCol).Value
     ' find and set Fase
     Call rngByHead(Source1, "Fase")
     Dim fase As String
     fase = .Cells(docSource1.Row, rngCol).Value
     ' find and set Status
     Call rngByHead(Source1, "Status")
     Dim status As String
     status = .Cells(docSource1.Row, rngCol).Value
     ' find and set versionnumber, note name difference
     Call rngByHead(Source1, "Wijziging")
     Dim versienummer As String
     versienummer = .Cells(docSource1.Row, rngCol).Value
End With
With Target
     ' find and write all variables to uploadlijst
     Call rngByHead(Target, "bestandsnaam")
     .Cells(cell.Row, rngCol).Value = bestand
     Call rngByHead(Target, "producent")
     .Cells(cell.Row, rngCol).Value = producent
     Call rngByHead(Target, "fase")
     .Cells(cell.Row, rngCol).Value = LCase(fase)
     Call rngByHead(Target, "status")
     .Cells(cell.Row, rngCol).Value = LCase(status)
     Call rngByHead(Target, "versienummer")
     .Cells(cell.Row, rngCol).Value = versienummer
End With

我正在尝试一个更简洁的选项，使用字典来匹配目标和数据表中的不同标题名称。我还创建了一个 secong 字典来将这些值存储在特定键下。我不断收到此代码错误，两个 424 对象都因 ByRef 参数类型不匹配而丢失。

' Create dict
Dim dict As Scripting.Dictionary
' Create dictValues
Dim dictValues As Scripting.Dictionary
Dim key As Object
    ' Add keys to dict
    dict("producent") = "Bedrijfsnaam"
    dict("fase") = "Fase"
    dict("status") = "Status"
    dict("versienummer") = "Wijziging"
    dict("documentdatum") = "Datum"
    dict("omschrijving1") = "Omschrijving 1"
    dict("omschrijving2") = "Omschrijving 2"
    dict("omschrijving3") = "Omschrijving 3"
    dict("discipline") = "Discipline"
    dict("bouwdeel") = "Bouwdeel"
    dict("labels") = "Labels"
' store values of sheet Source 1
With Source1
    ' create second dictValues to store values for each key
    Set dictValues = New Scripting.Dictionary
    ' loop through keys in dict, this line gives error 424
    For Each key In dict.Keys
          ' use dict to pass right value to rngByHead sub
          Call rngByHead(Target, dict(key))
          ' store value of cell to dictValues under same key
          dictValues(key) = .Cells(cell.Row, rngCol).Value
    Next key
End With
' set values to sheet Target
With Target
    ' loop through keys in dict
    For Each key In dict.Keys
          ' use dict to pass value of key item to rngByHead sub
          Call rngByHead(Target, key)
          ' set value of cell to dictValues
          .Cells(cell.Row, rngCol).Value = dictValues(key)
    Next key
End With

我做错了什么？我是 vba 字典的新手，无法弄清楚这一点。感谢您的帮助！

Answer 1

我修好了！在 Stackoverflow 上发布代码以供将来参考。结果很简单，我的字典工作正常。 key 或 k 变量设置为 Variant 或 Object，因此它没有将其值正确地作为 String 传递给 rngByHead 子。将 k 转换为 str 为 String 就可以了。

'sub that finds head in a specified worksheet and sets rngCol variable
Sub rngByHead(Sheet As Worksheet, head As String)
'setting up dictionary
Dim dict As New Scripting.Dictionary
Dim dictValues As New Scripting.Dictionary
Dim k As Variant
Dim str As String
'create dictionary
Set dictValues = New Scripting.Dictionary
Set dict = New Scripting.Dictionary
    'add keys to dict
    dict("producent") = "Bedrijfsnaam"
    dict("fase") = "Fase"
    dict("status") = "Status"
    dict("versienummer") = "Wijziging"
    dict("documentdatum") = "Datum"
    dict("omschrijving1") = "Omschrijving"
    dict("omschrijving2") = "Omschrijving 2"
    dict("omschrijving3") = "Omschrijving 3"
    dict("discipline") = "Discipline"
    dict("bouwdeel") = "Bouwdeel"
    dict("labels") = "Labels"
'store values of sheet Source 1
With Source1
    'find and set variables using dictionary
    'creating array of keys
    keys = dict.keys
    For Each k In keys
        Call rngByHead(Source1, dict(k))
        dictValues(k) = .Cells(docSource1.Row, rngCol).Value
    Next
End With
With Target
    'find and write variables using dictionary
    For Each k In keys
         'converting k as Variant to str as String
         str = k
         Call rngByHead(Target, str)
         .Cells(cell.Row, rngCol).Value = dictValues(k)
    Next
End With

另一个注意事项：您必须在Tools > References 下的Microsoft Visual Basic 代码编辑器中启用Microsoft Scripting Runtime。

假设用户在File -> Options -> Trust Center -> Trust Center Setttings -> Macro Settings 中启用了选项Trust Access to the VBA Project object model。您可以运行此代码并启用Microsoft Scripting Runtime 参考：

Sub Test()
    Dim Ref As Object, CheckRefEnabled%
    CheckRefEnabled = 0
    With ThisWorkbook
        For Each Ref In .VBProject.References
            If Ref.Name = "Scripting" Then
                CheckRefEnabled = 1
                Exit For
            End If
        Next Ref
        If CheckRefEnabled = 0 Then
            .VBProject.References.AddFromGUID "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0
        End If
    End With
End Sub

Answer 2

试试这样：

Dim dict As New Scripting.Dictionary
Dim dictValues As New Scripting.Dictionary

关键字New 从Scripting.Dicitionary 类型初始化一个对象。没有它，就不会初始化新对象，只会声明Scripting.Dictionary 类型的对象。这在 VBA 中称为早期绑定。在这里看一点 - What is the difference between Early and Late Binding?