Hallo Andi
Angaben sehr dürftig. Falls ich daraus alles richtig erstanden habe:
Option Explicit
' Vorgangsweise:
' Alle Daten der Tabelle 'Bestellung' von Saplte A bis H und bis zur letzten
' Daten in Spalte A werden in das Array 'arrBest' eingelesen. Analog alle
' Daten der Tabelle 'Wareneingang' von Saplte A bis C. Die ersten 3 Elemente
' in den beiden Array's werrden vergliche. Wenn gleich, dann wird kopiert.
' Einlesen und Array-Vergleich ist gegenüber anderen Methoden sehr schnell.
Sub Suchen_3_Kriterien()
Dim lz As Long, n As Long, x As Long
Dim arrBest(), arrEing()
Dim objRng As Range
Dim objWks_B As Worksheet
Dim objWks_E As Worksheet
' ** Bestellung ********************************
'Tabelle mit Daten welche ins Array müssen
Set objWks_B = ThisWorkbook.Worksheets("Bestellungen")
With objWks_B
' letzte Datenzeile in Tabelle 'Bestellung' der Spalte A
lz = .Cells(Rows.Count, "A").End(xlUp).Row
'Zellen mit Daten welche ins Array müssen (Spalte A - H, 2 bis letzte Zeile)
Set objRng = .Range(.Cells(2, 1), .Cells(lz, 8))
'Werte der Zellen in Array schreiben
arrBest = objRng.Value
End With
' **********************************************
' ** Lieferung ********************************
Set objWks_E = ThisWorkbook.Worksheets("Wareneingang")
With objWks_E
lz = .Cells(Rows.Count, "A").End(xlUp).Row
Set objRng = .Range(.Cells(2, 1), .Cells(lz, 3))
arrEing = objRng.Value
End With
' **********************************************
Application.ScreenUpdating = False
' Eigentliche Suche und vergleichen in den beiden Daten-Array's
For n = 1 To UBound(arrBest)
For x = 1 To UBound(arrEing)
If arrBest(n, 1) = arrEing(x, 1) And _
arrBest(n, 2) = arrEing(x, 2) And _
arrBest(n, 3) = arrEing(x, 3) Then
'Kopiervorgang von 'Bestellung' in 'Wareneingang'
With objWks_E
.Range(.Cells(n + 1, 9), .Cells(n + 1, 16)).Value = _
objWks_B.Range(objWks_B.Cells(n + 1, 1), objWks_B.Cells(n + 1, 8)).Value
End With
Exit For
End If
Next x
Next n
Application.ScreenUpdating = True
End Sub
mfg, GraFri
|