更新：VBAエラーExcelワークブックでワークシート「データ」と「サイクルカウントデータベース」へ

Question

おはよう辞書にキーを反復6オーバーフロー、

私が持っています。基本的には、ネットワークファイル（完全に動作する）からSQLクエリを使って「データ」シートをリフレッシュします。

リフレッシュ後、新しい値を「サイクルカウントデータベース」シートに貼り付けたいとします。情報が既に存在する場合、私はそれをコピーしたくない。私は新しいデータを追加したいだけです。実際には、そのアイテムのサイクルカウントを実行している新しいアイテムを追加し、古いアイテムからの「サイクルカウントデータベース」のデータを消去しないようにしたいと思います。

一般的に言えば、新しい項目は多くありません。しかし、初めてスプレッドシートを作成する場合、23080個のアイテムがあります。

はここに私の「データ」シートの頭だ：

A  B   C        D 
1 Active Item  Description      ABC 
2 A  A-FUL  "A" FULL SHIM KIT (2" X 2")  B 
3 A  A-MINI  "A" MINI SHIM KIT (2" X 2")  C 
4 A  A-SHIMBOX BLACK BOX FOR 2X2 SHIM KIT  X 
5 A  A-001  A (2" X 2").001" SHIM PACK/20 C 
6 S  A-002  A (2" X 2").002" SHIM PACK/20 C 

は、理想的には私は「アクティブ」（カラムA）欄に「A」を持つ行のみをコピーしたいと思います。 （ "S"はアイテムが中断されていることを示しますが、将来アイテムが "A"から "S"に変更された場合、 "サイクルカウントデータベース"シートの "A"を "S"それは別の問題です。

「アイテム」（列B）の値が「サイクルカウントデータベース」にある場合、私は何もしたくありません。しかし、 "Item"が存在しない場合は、 "Cycle Count Database"シートの一番下の行にColumns A：Dを貼り付けたいと思います。

Option Explicit 

Sub RefreshData() 

    With Application 
     .ScreenUpdating = False 
     .DisplayStatusBar = False 
     .EnableEvents = False 
     .Calculation = xlCalculationManual 
    End With 

    ' Set workbook definitions 
    Dim wbk As Workbook 
    Set wbk = ThisWorkbook 
    ' Set worksheet definitions 
    Dim shtData As Worksheet 
    Set shtData = wbk.Sheets("Data") 
    Dim shtCC As Worksheet 
    Set shtCC = wbk.Sheets("Cycle Count Database") 


    ' Refresh SQL query for data from AS400 
    wbk.RefreshAll 

    ' Create dictionary of items 
    Dim Dic As Object, key As Variant, oCell As Range, i& 
    Set Dic = CreateObject("Scripting.Dictionary") 

    ' Calculate number of rows in Data sheet 
    i = shtData.Cells.SpecialCells(xlCellTypeLastCell).Row 

    ' Store Data key, values in Dictionary 
    For Each oCell In shtData.Range("B2:B" & i) 
     If Not Dic.exists(oCell.Value) Then 
      Dic.Add oCell.Value, oCell.Offset(, 1).Value 
     End If 
    Next 

    'Debug.Print (Dic.Count) 

    ' Calculate number of rows in Dic + number of rows in database 
    i = Dic.Count + shtCC.Cells.SpecialCells(xlCellTypeLastCell).Row + 1 

    ' If dictionary key not present, paste into database 
    For Each oCell In shtCC.Range("B2:B" & i) 
     For Each key In Dic 
      If oCell.Value <> key Then 
       oCell.Value = key 
       oCell.Offset(, 1).Value = Dic(key) 
      End If 
     Next 
    Next 

    With Application 
     .ScreenUpdating = True 
     .DisplayStatusBar = True 
     .EnableEvents = True 
     .Calculation = xlCalculationAutomatic 
    End With 

End Sub 

をライン上でファイル名を指定して実行時エラー6で：その後、私は列Bのアルファベット順にフィルタリングするフィルタで

を置くここに私はこれまで起こってきたものだ

If oCell.Value <> key Then 

私はすべての鐘と笛を持っていないと私はあなたがそれらを作成するために探していることを実現します。私はちょっとした文脈のためにあなたに全体の絵を与えたいと思っていました。私は実際にこのオーバーフローコードを受け取らずに新しい情報をコピーするだけで助けが必要です...

ありがとう！

更新：これで、辞書の最初のエントリを繰り返して貼り付けることができます。しかし、forループは追加の行に移動せず、最初の行を何度も何度も複製します。だから、私はどこかのループのための順序の問題を持っている疑いがある：

Option Explicit 

Sub RefreshData() 

    With Application 
     .ScreenUpdating = False 
     .DisplayStatusBar = False 
     .EnableEvents = False 
     .Calculation = xlCalculationManual 
    End With 

    ' Set workbook definitions 
    Dim wbk As Workbook 
    Set wbk = ThisWorkbook 
    ' Set worksheet definitions 
    Dim shtData As Worksheet 
    Set shtData = wbk.Sheets("Data") 
    Dim shtCC As Worksheet 
    Set shtCC = wbk.Sheets("Cycle Count Database") 


    ' Refresh SQL query for data from AS400 
    'wbk.RefreshAll 

    ' Create dictionary of items 
    Dim Dic As Object, key As Variant, oCell As Range, i& 
    Set Dic = CreateObject("Scripting.Dictionary") 

    ' Calculate number of rows in Data sheet 
    i = shtData.Cells.SpecialCells(xlCellTypeLastCell).Row 

    ' Store Data key, values in Dictionary 
    For Each oCell In shtData.Range("B2:B" & i) 
     If Not Dic.Exists(oCell.Value) Then 
      Dic.Add oCell.Value, oCell.Offset(, 1).Value 
     End If 
    Next 

    'Debug.Print (Dic.Count) 

    ' Calculate number of rows in Dic + number of rows in database 
    i = Dic.Count + shtCC.Cells.SpecialCells(xlCellTypeLastCell).Row + 1 

    ' If dictionary key not present, paste into database 
    For Each oCell In shtCC.Range("B2:B" & i) 
     For Each key In Dic 
      If Not Dic.Exists(oCell.Value) Then 
        oCell.Value = key 
        oCell.Offset(, 1).Value = Dic(key) 
      End If 
     Next 
    Next 

    With Application 
     .ScreenUpdating = True 
     .DisplayStatusBar = True 
     .EnableEvents = True 
     .Calculation = xlCalculationAutomatic 
    End With 

End Sub 

結果で：

A  B  C       D 
1 Active Item Description     ABC 
2  A-FUL "A" FULL SHIM KIT (2" X 2") 
3  A-FUL "A" FULL SHIM KIT (2" X 2") 
4  A-FUL "A" FULL SHIM KIT (2" X 2") 
5  A-FUL "A" FULL SHIM KIT (2" X 2") 
... 

Answer 1

あなたが使用する必要がある辞書のキーを反復処理するには.Keys（）メソッドは、ちょうどDicを使わないでください。

Option Explicit 

Sub RefreshData() 

    With Application 
     .ScreenUpdating = False 
     .DisplayStatusBar = False 
     .EnableEvents = False 
     .Calculation = xlCalculationManual 
    End With 

    ' Set workbook definitions 
    Dim wbk As Workbook 
    Set wbk = ThisWorkbook 
    ' Set worksheet definitions 
    Dim shtData As Worksheet 
    Set shtData = wbk.Sheets("Data") 
    Dim shtCC As Worksheet 
    Set shtCC = wbk.Sheets("Cycle Count Database") 


    ' Refresh SQL query for data from AS400 
    'wbk.RefreshAll 

    ' Create dictionary of items 
    Dim Dic As Object, key As Variant, oCell As Range, i& 
    Set Dic = CreateObject("Scripting.Dictionary") 

    ' Calculate number of rows in Data sheet 
    i = shtData.Cells.SpecialCells(xlCellTypeLastCell).Row 

    ' Store Data key, values in Dictionary 
    For Each oCell In shtData.Range("B2:B" & i) 
     If Not Dic.Exists(oCell.Value) Then 
      Dic.Add oCell.Value, oCell.Offset(, 1).Value 
     End If 
    Next 

    'Debug.Print (Dic.Count) 

    ' Calculate number of rows in Dic + number of rows in database 
    i = Dic.Count + shtCC.Cells.SpecialCells(xlCellTypeLastCell).Row + 1 

'-------------THIS--------------------- 
    ' If dictionary key not present, paste into database 
    For Each oCell In shtCC.Range("B2:B" & i) 
     For Each key In Dic.Keys 
      If Not Dic.Exists(oCell.Value) Then 
        oCell.Value = key 
        oCell.Offset(, 1).Value = Dic(key) 
      End If 
     Next 
    Next 
'----------------------------------------- 

    With Application 
     .ScreenUpdating = True 
     .DisplayStatusBar = True 
     .EnableEvents = True 
     .Calculation = xlCalculationAutomatic 
    End With 

End Sub 

アップデート - 私は完全にあなたがやろうとしているので、次の擬似コードは全く役に立たないかもしれないものを理解していれば、私は知りません。

' Populate Dictionary with data from CCD 
Dim CCDic as Dictionary 
For Each Cell In CCD.Range 
    If Not CCDic.Exists(Cell.Value) Then 
     CCDic.Add Cell.Value, Cell.Offset(,1).Value 
    End If 
Next 

' Populate another dictionary from Data 
Dim DDic as Dictionary 
For Each Cell in Data.Range 
    If Not DDic.Exists(Cell.Value) Then 
     DDic.Add Cell.Value, Cell.Offset(,1).Value 
    End If 
End If 

' Remove any duplicate items from DDic (leaving only new items) 
Dim Key As Variant 
For Each Key In DDic.Keys 
    If CCDic.Exists(Key) Then 
     DDic.Remove Key 
    End If 
Next  

' Iterate over DDic and append data to CCD 
For Each Key In DDic.Keys 
    ' Code to do that 
Next 

アップデート2 - もう少し考えてみましたが、CCDとデータシートの両方の辞書を作成する必要はありません。スクリプトエディタで「Microsoftスクリプトランタイム」への参照を追加する場合

' Populate Dictionary with data from CCD 
Dim CCDic as Dictionary 
For Each Cell In CCD.Range 
    If Not CCDic.Exists(Cell.Value) Then 
     CCDic.Add Cell.Value, Cell.Offset(,1).Value 
    End If 
Next 

' Look for and keep new records 
Dim NewDic as Dictionary 
For Each Cell In Data.Range 
    If Not CCDic.Exists(Cell.Value) Then 
     If Not NewDic.Exists(Cell.Value) Then 
      NewDic.Add Cell.Value, Cell.Offset(,1).Value 
     End If 
    End If 
Next 

' Iterate over NewDic and append data to CCD 
For Each Key In NewDic.Keys 
    ' Code to do that 
Next 

あなたがDim X As Dictionaryを行うことができますので、それがVBAにDictionaryオブジェクトを追加し、それはデバッグ時に便利であるそれらものためのインテリセンスビットを付加。最後にCreateObject('Scripting.Dictionary')に変更すると、移植性に役立ちます