2017-09-26 7 views
0

セルをあるシートから別のシートにコピーして、列ヘッダー名を見つけて一致させ、正しいセルに貼り付ける。これらの列ヘッダー名は、同じデータが含まれていますが、シートごとにわずかに異なります。私は、ターゲットとデータシートで異なるヘッダ名を一致させるための辞書と、よりクリーンなオプションをしようとしていたVBA-excel dictionary

' 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 

:私の作業のコードでは、繰り返しをたくさん持っています。これらの値を特定のキーの下に格納するためにセコング辞書を作成しました。このコードでは、ByRef引数の型の不一致として424個のオブジェクトが欠けています。

' 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辞書には新しく、これを理解することはできません。ご協力いただきありがとうございます!

答えて

0

は次のように試してみてください:

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?

+0

はまだ 'コールrngByHead(ターゲット、キー)'内の変数キーのエラー_ByRef引数の型mismatch_を与えます – thomascs

0

私はそれを修正しました!将来の参照のためにここにStackoverflowでコードを投稿してください。それは非常に簡単であることが分かった、私の辞書は正常に動作していた。 keyまたはk変数はVariantまたはObjectと設定されていたため、rngByHeadサブにStringという値が正しく渡されませんでした。 kstrに変換して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 

別のノート:あなたは>ReferencesToolsの下でMicrosoft Visual BasicのコードエディタでMicrosoft Scripting Runtimeを有効にする必要があります。 >Options - - >Trust Center - >Trust Center Setttings - >Macro Settingsユーザー提供

Fileにオプション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