Vergleich
KON
super Klasse ,das funktioniert. Besonders geil und hilfreich wäre es wenn jetzt noch die Mengen aus Spalte G von Tabelle 2 in Spalten D vom Ergebnis eingetragen würde.
Vorerst vielen Dank, das Ergebnis bisher ist Spitzenklasse.
Viele Grüße
KON
Hallo Experten,
ich habe da eine Herausforderung für euch die mir sehr helfen würde.
Bei 2 Tabellen die Artikelnummer vergleichen und bei Übereinstimmung die Daten bei Tabelle 1 aus Spalte D und bei Tabelle 2 aus Spalte H nebeneinander in neues Tabellenblatt eintragen. Bei Tabelle 1 steht die Artikelnummer in Spalte B und bei Tabelle 2 steht die Artikelnummer in Spalte E.
Danke Für die Hilfe
Gruß
KON
Hallo,
es sollt nur die erste Übereinstimmung übernommen werden und erst ab Zeile 2.
Tabelle evtl. im Code noch anpassen.
Sub Test()
Dim ArrayTab1(), ArrayTab2(), NewArray()
Dim oDic As Object, oDicMerk As Object
Dim nCount&, A&, B&
Set oDic = CreateObject("Scripting.Dictionary")
Set oDicMerk = CreateObject("Scripting.Dictionary")
With Tabelle1 'Tabelle1 evtl. anpassen
'B2 bis D?
ArrayTab1 = .Range("B2", .Cells(.Rows.Count, 2).End(xlUp)).Resize(, 3)
End With
With Tabelle2 'Tabelle2 evtl. anpassen
'E2 bis H?
ArrayTab2 = .Range("E2", .Cells(.Rows.Count, 5).End(xlUp)).Resize(, 4)
End With
For A = 1 To Ubound(ArrayTab1)
If ArrayTab1(A, 1) "" Then _
oDic(ArrayTab1(A, 1)) = ArrayTab1(A, 3)
Next A
nCount = Application.Max(Ubound(ArrayTab1), Ubound(ArrayTab2))
Redim Preserve NewArray(1 To nCount, 1 To 3)
nCount = 0
For A = 1 To Ubound(ArrayTab2)
If oDic.exists(ArrayTab2(A, 1)) Then
If Not oDicMerk.exists(ArrayTab2(A, 1)) Then
nCount = nCount + 1
NewArray(nCount, 1) = ArrayTab2(A, 1)
NewArray(nCount, 2) = oDic(ArrayTab2(A, 1))
NewArray(nCount, 3) = ArrayTab2(A, 4)
oDicMerk(ArrayTab2(A, 1)) = 0
End If
End If
Next A
If nCount > 0 Then
With ThisWorkbook
With .Sheets.Add(After:=.Sheets(.Sheets.Count))
With .Cells(2, 1).Resize(Ubound(NewArray), Ubound(NewArray, 2))
.Value = NewArray
.EntireColumn.AutoFit
End With
End With
End With
End If
End Sub
Gruß Tino