VBA-Excel字典

Question

Im copying cells from one sheet to another, finding and matching column header names and pasting to the correct cell. These column header names differ slightly per sheet, altough they contain the same data. My working code has a lot of repetition:

' 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

I was trying a more cleaner option with a dictionary for matching the different header names in target and data sheets. I also created a secong dictionary to store those values under the specific keys. I keep getting errors on this code, both 424 object missing as ByRef argument type mismatch.

' 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

What am I doing wrong? I'm new to vba dictionary and can't figure this one out. Thanks for your help!

Answer 1

Try like this:

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

The keyword New initializes an object from type Scripting.Dicitionary . Without it, no new object is initialized, just an object of type Scripting.Dictionary is declared. This is called early binding in VBA. See a bit here - What is the difference between Early and Late Binding?

Answer 2

I fixed it! Posting the code here on Stackoverflow for future reference. It turned out to be very simple, my dictionary was working fine. The key or k variable was set as Variant or Object , so it didn't pass it's value correctly as String to the rngByHead sub. Converting the k to str as String did the trick.

'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

Another note: you have to enable Microsoft Scripting Runtime in microsoft visual basic code editor under Tools > References .

Provided a user has enabled the option Trust Access to the VBA Project object model in File -> Options -> Trust Center -> Trust Center Setttings -> Macro Settings . You can run this code and enable the Microsoft Scripting Runtime reference:

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