Suche mit For-Schleife
30.01.2017 09:32:30
Sebastian
ich hoffe mir kann geholfen werden.
Ich möchte gerne Informationen aus 2 Excel-Listen zusammen führen. Da eine davon ein jeweils aktualisierter Export mit variierendem Dateinamen ist, will ich die Routine als Makro in der Zieldateil implementieren.
Leider bekomme ich gerade den Fehler: "Fehler beim Kompilieren: Next ohne For" angezeigt. Dabei gibt es die For Funktion ...
Kann mir da jemand weiter helfen?
Hier mal was ich machen möchte in Stichpunkten:
- Makro wird aus Export-Datei gestartet, sonst Fehlermeldung
- Export wird in Spalte K absteigend sortiert
- In Zieldatei wird überprüft ob es eine "Überschriftenzeile" ist (diese enthält "|")
- Die Suche soll nur für Zeilen mit Daten (Spalte A) heute oder in der Zukunft angewendet werden
- Wenn das so ist, wird der Wert aus Spalte D als Suchwert genommen und in der Export-Datei in Spalte K gesucht
- Bei Mehrfachtreffern wird ein Text in der Zieldatei Spalte L ausgegeben
- Bei eindeutigen Treffern werden die Werte der Spalten B und C der Export Datei in Spalten L und M der Zieldatei kopiert.
- Gibt es keinen Treffer gibt es einen entsprechenden Text in der Zieldatei Spalte L
Hier mal der Code mit dem angezeigten Fehler:
Sub Import_Infos()
'Check ob Makro in Export ausgeführt wird und Benachrichtigung+Ende wenn nicht
If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox ("Bitte öffnen Sie den Export und starten das Makro dort erneut.")
Exit Sub
'Ermitteln und speichern des Dateinamens des geöffneten Exports
Else
Dim a As String
a = ActiveWorkbook.Name
End If
'Export nach Nummern in Spalte K sortieren
Range("K1").Select
ActiveWorkbook.Worksheets("Extract").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Extract").Sort.SortFields.Add Key:= _
Range("K1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Impact").Sort
.SetRange Range("A2:O" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Abgleich ob Datum in der Zukunft liegt
Windows(ThisWorkbook.Name).Activate
Sheets("Tabelle3").Select
Dim Zeile As Integer
Dim Ende As Integer
Ende = Sheets("Tabelle3").UsedRange.SpecialCells(xlCellTypeLastCell).Row
For Zeile = 7 To Ende
'Überprüfung ob eine Überschriftenzeile vorliegt. Wenn nein, dann...
If InStr(Cells(Zeile, 2), "|") = 0 Then
'Wenn Datum heute oder in der Zukunft ist, dann ...
If Cells(Zeile, 2) >= Date Then
'... behalte Nummer und gehe in Export
Dim Nummer As String
Nummer = Cells(Zeile, 4)
Dim Zeile2 As Integer
Dim Ende2 As Integer
Windows(a).Activate
Ende2 = Sheets("Extract").UsedRange.SpecialCells(xlCellTypeLastCell).Row
Zeile2 = 1
'Suche Nummer in Spalte K und übergib in Übersicht folgenden Wert:
Do
Zeile2 = Zeile2 + 1
If InStr(Cells(Zeile2, 11), Nummer) > 0 And InStr(Cells(Zeile2 + 1, 11), _
Nummer) > 0 Then
Windows(ThisWorkbook.Name).Activate
Sheets("Tabelle3").Select
Cells(Zeile, 12) = "There are multiple matches for this Number. Please _
_
_
check the status manually!"
Range(Cells(Zeile, 12)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Exit Do
'Wenn Nummer einmal vorkommt wird Nummer2 und Status in Übersicht übertragen und weiter mit nä _
_
_
chster Nummer
ElseIf InStr(Cells(Zeile2, 11), Nummer) > 0 Then
Dim Nummer2 As String
Dim Status As String
Nummer2= Cells(Zeile2, 2)
Status = Cells(Zeile2, 3)
Windows(ThisWorkbook.Name).Activate
Sheets("Tabelle3").Select
Cells(Zeile, 12) = Nummer2
Cells(Zeile, 13) = Status
Exit Do
'Wenn Nummer nicht in der Liste gefunden wird (wir sind in der letzten Suchzeile angekommen) _
Eintrag in Übersicht
'(Hintergrund rot) und weiter mit nächster Nummer
ElseIf Zeile2 = Ende2 Then
Cells(Zeile, 12) = "No entries available for this number!"
Range(Cells(Zeile, 12)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Exit Do
'Wenn kein Suchtreffer und noch nicht die letzte Zeile erreicht wurde, wird in die nächste _
Suchzeile gesprungen.
End If
Loop
'Wenn Überschrift oder Datum in der Vergangenheit Vorliegt, wird in die nächste Zeile _
gesprungen
End If
Next Zeile
End Sub