Hallo Max,
hier ist der überarbeitete Code. Prüfe mal, ob die entsprechenden Angaben stimmen:
Sub suche()
Dim varZone As Variant
Dim varSuche As Variant
Dim varShip As Variant
Dim lngLZeile As Long
Dim lngLSpalte As Long
Dim s As Long
Dim sc As Long
Dim z As Long
Dim i As Long
Dim u As Long
Dim x As Long
Dim strService As String
'Daten aus Tabellenblatt Eingabe in Feld einlesen
With Worksheets("Eingabe")
lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row 'Letzte Zeile in Spalte A
lngLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column 'Letzte Spalte in Zeile 1
varSuche = .Range(.Cells(1, 1), .Cells(lngLZeile, lngLSpalte)) 'Daten in Feld einlesen
End With
'Zonen in Feld einlesen
With Worksheets("Zonen")
varZone = .UsedRange
End With
'ShipCost in Feld einlesen
With Worksheets("ShpCost")
lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row 'Letzte Zeile in Spalte A
lngLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column 'Letzte Spalte in Zeile 1
varShip = .Range(.Cells(1, 1), .Cells(lngLZeile, lngLSpalte)) 'Daten in Feld einlesen
End With
'Suchfeld durchlaufen
For s = 2 To UBound(varSuche, 1)
'Zone durchsuchen
For z = 2 To UBound(varZone, 1)
'Absender-Postleitzahl wird gesucht
If varSuche(s, 2) >= varZone(z, 2) And varSuche(s, 2) <= varZone(z, 3) Then
'Zielland wird gesucht
If varSuche(s, 3) = varZone(z, 4) Then
'Zielpostleitzahl wird gesucht
If varSuche(s, 4) >= varZone(z, 5) And varSuche(s, 4) <= varZone(z, 6) Then
'gefundene Daten werden per Schleife in Suchfeld übertragen
For i = 5 To 11
varSuche(s, i) = varZone(z, i + 2)
Next i
End If
End If
End If
Next z
'ShpCost durchlaufen
For sc = 2 To UBound(varShip, 1)
'hier werden die Spalten L bis P aus der Tabelle Eingabe durchlaufen
For i = 12 To 16 Step 2
'hier wird der Service aus dem Suchfeld in der Tabelle ShpCost gesucht
If varSuche(1, i) = varShip(sc, 1) Then
'falls eine Übereinstimmung gefunden wurde, wird der entsprechende Inhalt in ShpCost gesucht
If varSuche(s, 19) = varShip(sc, 2) Then
'hier wird das entsprechende Gewicht gesucht
If varSuche(s, 18) >= varShip(sc, 3) And varSuche(s, 18) <= varShip(sc, 4) Then
'hier werden nun die Daten aus den Spalten E bis K in ShpCost gesucht
'da für Express Weekend die selben Bedingungen gelten, wie für Express, wird dieser als Suchbegriff ersetzt
If varSuche(1, i) = "Express Weekend" Then
strService = "Express"
Else
strService = varSuche(1, i) 'ansonsten wird der normale Suchbegriff verwendet
End If
'nun in den Spalten E bis K nach der entsprechenden Überschrift suchen
For x = 5 To 11
If strService = varSuche(1, x) Then
'falls Übereinstimmung gefunden, werden nun die Überschriften aus ShpCost nach der gefundenen Überschrift durchsucht
For u = LBound(varShip, 2) To UBound(varShip, 2)
If varSuche(s, x) = varShip(1, u) Then
'bei Übereinstimmung werden die gefundenen Daten in das Suchfeld geschrieben
varSuche(s, i) = varShip(sc, u) 'Preis
varSuche(s, i + 1) = varShip(sc, 5) 'Rate Type aus Spalte E der Datei ShpCost
Exit For
End If
Next u
End If
Next x
End If
End If
End If
Next i
Next sc
Next s
'Daten ausgeben
With Worksheets("Eingabe")
For s = 2 To UBound(varSuche, 1)
For i = 5 To 17
If varSuche(s, i) <> "" Then
.Cells(s, i) = varSuche(s, i) 'gefundene Daten werden in die jeweiligen Zellen geschrieben
Else
'falls das Suchfeld leer ist, wird entsprechender Text ausgegeben
.Cells(s, i) = "Nichts gefunden"
End If
Next i
Next s
End With
End Sub
Ich habe auch alles kommentiert, damit man es möglichst nachvollziehen kann.
Viel Spaß beim Lesen deines Buches. Vergiß aber nicht, auch auszuprobieren!
Gruß
M.O.
