Excel VBA - Vergleichen eines Wertes zwischen 2 Arrays und Zurückgeben

Question

Lange Zeit lurker hier und endlich haben sich um eine Frage zu stellen (vielen Dank im Voraus für Ihre Hilfe).

Also das Problem, das ich habe, ist wie folgt:

Ich habe 2 Tabellen, die eine identische Säulenstruktur haben, wo die Informationen aus einer anderen Abteilung übergeben werden in die erste Vorlage setzen. Ich möchte 1 an der SKU aus der Tabelle sehen und alles passiert zurück, die in Tabelle 2 auf dieser Zeile entspricht - unter Nichtberücksichtigung jeden SKU Code, der nicht auf Tabelle 1.

Graphical illustration of My problem

Im Moment, ich habe der aktuelle Code als Teil eines größeren VBA Unter (Variablen werden vor usw. erklärt), die ein Scripting-Wörterbuch verwendet und geht dann durch eine For-Schleife - aber das ist nicht effizient:

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 

ich tausende von SKU-Codes habe und das braucht Zeit, um durchzulaufen. Mir wurde gesagt, dass ich dadurch den Job unendlich schneller machen kann, wenn ich dies außerhalb des Bogens mache.

Nochmals vielen Dank für Ihre Hilfe - Sie waren Lebensretter in der Vergangenheit! Edit:

Hier ist meine ganze Code, so gibt Kontext ist:

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

Sie Find Funktion können Sie für die Zeilennummer, die Sie suchen finden. Mit dieser Zeilennummer können Sie dann die Daten aus dieser Zeile abrufen.

Ich habe nicht zu viel in Ihren Code eingegraben, weil es ein bisschen unordentlich ist. Also man bedenkt, dass:

• Blank Lookup Blattname ist "Tabelle 1 BLATT",
• Master-Lookup Blattname ist "TABELLE 2 BLATT",
• Ergebnisse Blattname "Tabelle 3 BLATT" ist,

dann können Sie versuchen, die folgenden:

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