Weitersuchen in Schleife
11.06.2020 15:13:45
Kerstin
Ich stehe wieder einmal "auf dem Schlauch"und brauche eure Hilfe:
Ich habe folgenden Code (hier im Forum gefunden), der folgendes macht:
In einer Liste in Blatt "Autoren_und_Titellsite" in der Spalte A nach einem Nachnamen suchen und in Spalte B nach einer Nummer suchen.
Die zu suchenden Werte stehen in Blatt "Bucherfassung" in Zelle G4 (Nachname) und in Zelle K4 (Nummer). Wenn beides nebeneinander gefunden wurde, wird die nebenstehende Zelle (SpalteC) aktiviert.
Klappt bestens!
Nun kann es aber dummerweise sein, daß der Nachname mit der GLEICHEN NUMMER mehrfach im Blatt "Autoren_und_Titelliste" steht. Deshalb hätte ich gerne, daß mit einer vbYesNo Abfrage nach dem ersten Treffer weitergesucht werden kann. Egal, wohin ich meine vbYesNo Abfrage packe, der Debugger meckert (Fehler beim Kompilieren: "Next" ohne "For"). Ihr wisst bestimmt Rat...
Hier ist mein Code:
Sub TestSucheZweiSpalten()
If Sheets("Bucherfassung").Range("K4") "" And Sheets("Bucherfassung").Range("K4") > 1 _
And Sheets("Bucherfassung").Range("J3") = "Serientitel" Then 'Untertitel unf Band
Dim Bereich As Range
Dim LRow As Long, Anzahl As Long, Zeile
Dim Wert1, Wert2
Dim Gefunden As Boolean
Wert1 = Sheets("Bucherfassung").Range("G4").Value 'Suchwert1(Autor NN)
Wert2 = Sheets("Bucherfassung").Range("K4") - 1 'Suchwert2(BandNr)
With Sheets("Autoren_und_Titelliste") 'zu durchsuchende _
Tabelle
Set Bereich = .Range("A1", .Cells(.Rows.Count, 2).End(xlUp).Offset(0, -1))
Anzahl = Application.WorksheetFunction.CountIf(Bereich, Wert1 & "*")
For LRow = 1 To Anzahl
Zeile = Application.Match(Wert1 & "*", Bereich, 0)
If IsNumeric(Zeile) Then
Anzahl = IIf(LRow = 1, Zeile, Anzahl + Zeile)
If .Cells(Anzahl, 2) Like "*" & Wert2 & "*" Then
.Select
.Cells(Anzahl, 3).Select
Gefunden = True
Exit For
''**********weiter mit Ja/ Nein ***************
'MB1 = MsgBox("Ist dies die gesuchte Serie (" & Sheets("Bucherfassung").Range("J4") & ")?" & _
vbLf & vbLf & vbLf, vbYesNo)
' If MB1 = vbYes Then
' ActiveCell.Copy
' Sheets("Bucherfassung").Range("AJ4").PasteSpecial Paste:=xlValues
' Application.CutCopyMode = False
' MsgBox "Serienpunkt *" & Range("AJ4") & "* wurde hinzugefügt"
' Exit For
' ElseIf MB1 = vbNo Then
'' MsgBox "Weitersuchen!"
' End If
Else
Set Bereich = .Range(Bereich.Offset(Zeile, 0), Bereich(Bereich.Cells.Count))
Zeile = Application.Match(Wert1 & "*", Bereich, 0)
End If
End If
Next LRow
End With
If Gefunden = False Then MsgBox "Autor wurde nicht gefunden!"
End If
End Sub
Vielen dank schon mal für die Hilfe!
VG
Kerstin