Excel VBA - 2つの配列間の値を比較して返す

Question

長い時間のルルカーがここに来て、最後に質問をしています。

次のようにだから私は持っている問題は、次のとおりです。

私は別の部署から渡された情報が第一のテンプレートに入れて同じ列構造を持つ2つのテーブルを持っています。私は、現時点で

Graphical illustration of My problem

1.表上にない任意のSKUコードを無視しながら - 私は、表1からSKUを見てみたいと戻って、表2にその行に一致するすべてのものを渡しますスクリプト辞書を使用して、ループのために通過するより大きなVBAサブの一部として現在の符号（変数は前等宣言され） - が、これは効率的ではない。

Set dlCD1 = CreateObject("Scripting.Dictionary") 
Row = 1 
On Error GoTo Error 
For Each cCD1 In Sheets("TABLE 2 SHEET").Range("c1:c" & MaxLineMPS) 
tmpCD1 = Trim(cCD1.Value) 
If Len(tmpCD1) < 10 Then tmpCD1 = "0" & tmpCD1 
If Len(tmpCD1) > 0 Then dlCD1(tmpCD1) = dlCD1(tmpCD1) + 1 
Next cCD1 

For Each kCD1 In dlCD1.keys 

With Sheets("TABLE 1 SHEET").Range("a2:x" & MaxLineMatrice) 
.AutoFilter Field:=3, Criteria1:=kCD1 
End With 

If Sheets("TABLE 1 SHEET").Range("A2:A" & MaxLineMatrice).SpecialCells(xlCellTypeVisible).Count > 1 Then 
With Sheets("TABLE 1 SHEET").Range("d$3:x" & "$" & MaxLineMatrice).SpecialCells(xlCellTypeVisible) 
.Value = Sheets("TABLE 2 SHEET").Range("$d" & "$" & Row & ":$x" & "$" & Row).Value 
End With 
Else: End If 

Row = Row + 1 
Debug.Print kCD1, dlCD1(kCD1) 
Next kCD1 

Worksheets("TABLE 1 SHEET").AutoFilterMode = False 
dlCD1.RemoveAll 

Iは、SKUコードの数千を持っていますループスルーするには時間がかかります。シートの外でこれを行うことで、私は仕事を無限に速く行うことができると言われています。

あなたの助けをもう一度おねがいします - あなたたちは過去に命を救ってきました！ 編集：コンテキストがありますので、

は、ここに私の全体のコードです：

Sub Month_RiempiFuturo() 
Dim MinLineMatrice As Integer, MaxLineMatrice As Integer, MinLineMPS As Integer, MaxLineMPS As Integer, row As Integer 
Dim dlCD1 As Object, cCD1 As Range, kCD1, tmpCD1 As String, dlCD2 As Object, cCD2 As Range, kCD2, tmpCD2 As String 
Dim StartTime As Double, SecondsElapsed As Double 
Dim PT1 As PivotTable 
Application.EnableEvents = False 
Application.DisplayStatusBar = False 
Application.ScreenUpdating = False 
ActiveSheet.DisplayPageBreaks = False 
Application.Calculation = xlCalculationManual 
Worksheets("TABLE SHEET 1").AutoFilterMode = False 
Worksheets("TABLE SHEET 2").AutoFilterMode = False 
StartTime = Timer 
MinLineMatrice = 3 
MaxLineMatrice = Sheets("TABLE SHEET 1").Range("A" & Rows.Count).End(xlUp).Row 
MinLineMPS = 1 
MaxLineMPS = Sheets("TABLE SHEET 2").Range("C" & Rows.Count).End(xlUp).Row 
LastLineFINITY = Sheets("FINITY CAPACITY PLANNED").Range("A" & Rows.Count).End(xlUp).Row 
Set PT1 = Worksheets("shift").PivotTables("Tabella_pivot1") 
Worksheets("TABLE SHEET 1").Range("d3:x" & MaxLineMatrice).ClearContents 
Set dlCD1 = CreateObject("Scripting.Dictionary") 
        Row = 1 
        On Error GoTo Error 
        For Each cCD1 In Sheets("TABLE SHEET 2").Range("c1:c" & MaxLineMPS) 
         tmpCD1 = Trim(cCD1.Value) 
         If Len(tmpCD1) < 10 Then tmpCD1 = "0" & tmpCD1 
         If Len(tmpCD1) > 0 Then dlCD1(tmpCD1) = dlCD1(tmpCD1) + 1 
         Next cCD1 
         For Each kCD1 In dlCD1.keys 
          With Worksheets("TABLE SHEET 1").Range("a2:x" & MaxLineMatrice) 
          .AutoFilter Field:=3, Criteria1:=kCD1 
          End With 
           If Sheets("TABLE SHEET 1").Range("A2:A" & MaxLineMatrice).SpecialCells(xlCellTypeVisible).Count > 1 Then 
            With Sheets("TABLE SHEET 1").Range("d$3:x" & "$" & MaxLineMatrice).SpecialCells(xlCellTypeVisible) 
             .Value = Sheets("TABLE SHEET 2").Range("$d" & "$" & Row & ":$x" & "$" & Row).Value 
            End With 
           Else: End If 
          Row = Row + 1 
          Debug.Print kCD1, dlCD1(kCD1) 
          Next kCD1 
     Worksheets("TABLE SHEET 1").AutoFilterMode = False 
dlCD1.RemoveAll 
Set dlCD1 = CreateObject("Scripting.Dictionary") 
         For Each cCD1 In Sheets("Finity capacity planned").Range("a2:a" & LastLineFINITY) 
          tmpCD1 = Trim(cCD1.Value) 
           If Len(tmpCD1) > 0 Then dlCD1(tmpCD1) = dlCD1(tmpCD1) + 1 
         Next cCD1 
          Set dlCD2 = CreateObject("Scripting.Dictionary") 
           For Each cCD2 In Sheets("Finity capacity planned").Range("b2:b" & LastLineFINITY) 
          tmpCD2 = Trim(cCD2.Value) 
           If Len(tmpCD2) > 0 Then dlCD2(tmpCD2) = dlCD2(tmpCD2) + 1 
          Next cCD2 
         For Each kCD1 In dlCD1.keys 
           With Sheets("Finity capacity planned").Range("A1:Ak" & LastLineFINITY) 
           .AutoFilter Field:=1, Criteria1:=kCD1 
           .AutoFilter Field:=2, Criteria1:=Array(_ 
           dlCD2.keys()(0), dlCD2.keys()(2), dlCD2.keys()(4), dlCD2.keys()(6), dlCD2.keys()(8), dlCD2.keys()(10)), Operator:=xlFilterValues 
           End With 
           With Sheets("Finity capacity planned").Range("A2:Ak" & LastLineFINITY).SpecialCells(xlCellTypeVisible) 
           .Interior.ColorIndex = 15 
           End With 
           With Sheets("Finity capacity planned").Range("A1:Ak" & LastLineFINITY) 
           .AutoFilter Field:=1, Criteria1:=kCD1 
           .AutoFilter Field:=2, Criteria1:=Array(_ 
           dlCD2.keys()(1), dlCD2.keys()(3), dlCD2.keys()(5), dlCD2.keys()(7), dlCD2.keys()(9), dlCD2.keys()(11)), Operator:=xlFilterValues 
           End With 
           With Sheets("Finity capacity planned").Range("A2:Ak" & LastLineFINITY).SpecialCells(xlCellTypeVisible) 
           .Interior.ColorIndex = 19 
           End With 
         Debug.Print kCD1, dlCD1(kCD1) 
         Next kCD1 
     Worksheets("Finity capacity planned").AutoFilterMode = False 
dlCD1.RemoveAll 
dlCD2.RemoveAll 
      With PT1 
       .RefreshTable 
      End With 
Application.EnableEvents = True 
Application.DisplayStatusBar = True 
Application.ScreenUpdating = True 
ActiveSheet.DisplayPageBreaks = True 
Application.Calculation = xlCalculationAutomatic 
SecondsElapsed = Round(Timer - StartTime, 2) 
MsgBox "This code including the time for user prompts to be acknowledged took " & SecondsElapsed & " Seconds", vbInformation, "McManus automation speed testing" 
Exit Sub 
Error: 
Application.EnableEvents = True 
Application.DisplayStatusBar = True 
Application.ScreenUpdating = True 
ActiveSheet.DisplayPageBreaks = True 
Application.Calculation = xlCalculationAutomatic 
MsgBox "Something went wrong" 
End Sub 

Answer 1

あなたが探している行番号を見つけるためにFind機能を使用することができます。次に、この行番号を使用して、その行のデータを持つことができます。

私はあなたのコードをあまりにも掘り下げませんでした。なぜなら、ちょっと混乱しているからです。

• ブランクルックアップシート名が "TABLE 1 SHEET"、
• マスタールックアップシート名が "TABLE 2 SHEET" で、シート名が "TABLE 3 SHEET" である
• 結果、
がある：だからことを考慮すると、

その後、あなたは次のことを試すことができます。

Sub findmydata() 
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 
Dim i As Long, j As Long, foundrow As Long, lastrow1 As Long, lastrow2 As Long 

Set ws1 = Sheets("TABLE 1 SHEET") 
Set ws2 = Sheets("TABLE 2 SHEET") 
Set ws3 = Sheets("TABLE 3 SHEET") 

lastrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 
lastrow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row 

For i = 1 To lastrow1 
    On Error Resume Next 
    foundrow = ws2.Range("A1:A" & lastrow2).Find(ws1.Cells(i, 1).Value).Row 
    If Err.Number = 91 Then 
     ws3.Cells(i, 1) = ws1.Cells(i, 1) 
    Else 
     For j = 1 To 4 
      ws3.Cells(i, j) = ws2.Cells(foundrow, j) 
     Next j 
    End If 
Next 
End Sub