Wiederholungsschleife mit Platzhaltern
31.05.2020 14:21:56
Kerstin
Ich habe mir hier aus dem Forum aus verschiedenen Codeschnipseln folgenden Code zusammengebaut, der folgendes machen soll:
Der Wert aus Sheets("Bucherfassung").Range("I4")(=TiteL) soll in Spalte "B" in Sheets("Autoren_und_Titelliste") gesucht werden. Dabei kann es vorkommen, daß in Spalte "B" nicht nur der Titel steht, sondern auch noch andere Angaben wie z.B: Band 03, oder Serie: XYZ
Wenn der Titel gefunden wurde, soll geprüft werden, ob es noch weitere Titel mit dem gleichen Namen gibt. Diese sollen dann nacheinander angezeigt werden.
Sub SuchenTitel()
Dim TiteL, rngGefunden As Range
Dim strAdresse1 As String
Dim wksEingabe As Worksheet
Set wksEingabe = Worksheets("Bucherfassung")
TiteL = wksEingabe.Range("I4")
With Sheets("Autoren_und_Titelliste")
'Titel in Spalte B suchen
Set rngGefunden = Sheets("Autoren_und_Titelliste").Range("B:B").Find(What:=TiteL, Lookat:= _
_
_
xlWhole)
If rngGefunden Is Nothing Then
MsgBox "Titel ist noch nicht vorhanden"
Call Erschein_Datum_Neue_Bücher
Else
strAdresse1 = rngGefunden.Address
.Activate
.Rows(rngGefunden.Row).Select
'Suche wiederholen bis Titel übereinstimmt oder Suchadresse sich wiederholt
Do
'Prüfen ob Titel mit Suchbegriff übereinstimmt
If rngGefunden = TiteL Then
' 'Listen-Blatt aktivieren und Zeile markieren
.Activate
.Rows(rngGefunden.Row).Select
MB0 = MsgBox("Dieses Buch wurde bereits gekauft. Ist das der gleiche Titel?" & _
_
_
vbLf & vbLf & rngGefunden & vbLf & "von" & vbLf & rngGefunden.Offset(0, -1), vbYesNo)
If MB0 = vbYes Then
MB1 = MsgBox("Trotzdem weiter mit gleichem Buchtitel in Bucherfassung?" _
_
_
& vbLf & vbLf & vbLf & "Ja = weiter mit gleichem Buch" & vbLf & vbLf & vbLf & "Nein = Anderes _
_
Buch erfassen", vbYesNo)
If MB1 = vbYes Then
MsgBox "Call Erschein_Datum_Neue_Bücher"
ElseIf MB1 = vbNo Then
MsgBox "Call inputbox_Bucherfassung_Titel_neue_Bücher"
End If
Exit Sub
End If
'Nächste Zelle mit Titel suchen
Set rngGefunden = .Columns.FindNext(After:=rngGefunden)
'Prüfen, ob Suche wieder bei 1. Fundstelle angekommen ist.
If rngGefunden.Address = strAdresse1 Then
MsgBox "Bereich wurde abgesucht, keine weiteren Titel gefunden"
MsgBox "Call Erschein_Datum_Neue_Bücher"
Exit Sub
Exit Do
End If
End If
Loop
End If
End With
End Sub
Klappt auch ganz gut, bis auf 2 Kleinigkeiten:
1. Der TiteL wird auf dem gesamten Blatt gesucht, nicht nur in Spalte "B"
waruuuum?
(Wenn ich bei With.... auch die Spalte vorgebe, dann meckert der Debugger an der Stelle:
Else: str.Adresse1...
2. Durch ".Find(What:=TiteL...Lookat:=xlWhole)" findet Excel nur den exakten Wert, ich brauche aber eigentlich sowas wie:
"like "*" & wksEingabe.Range("I4") & "*"
Ersetze ich "....Lookat=xlWhole durch =xlPart" hängt sich Excel auf...
Ihr habt bestimmt eine Idee...
Liebe Grüße
Kerstin