Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Wiederholungsschleife mit Platzhaltern

Wiederholungsschleife mit Platzhaltern
31.05.2020 14:21:56
Kerstin
Hallo Excel-Cracks!
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

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 14:59:24
onur
Kein Wunder, denn mit
Set rngGefunden = .Columns.

sprichst du ALLE Spalten an.
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 15:33:17
Kerstin
Ok, habe ich verstanden, geändert und es klappt (natürlich!)
Danke sehr!
Hat noch jemand eine Idee wie ich "Ähnliche" Werte suchen kann?
Ich habe noch diesen Code gefunden, weiß aber nicht, was ich schreiben muß, wenn NICHTS gefunden wird...
Sub vergleichen()
Dim l As Long
For l = 1 To 5000
If InStr(1, Sheets("Autoren_und_Titelliste").Range("B" & l).Value, Sheets(" _
Bucherfassung").Range("I4"), vbTextCompare) > 0 Then
MsgBox Sheets("Autoren_und_Titelliste").Range("B" & l).Value & "  *   " & Range("B"  _
& l).Offset(0, -1) & " gefunden"
End If
Next
Exit Sub
End Sub

z.B.
ElseIf InStr(1, Sheets("Autoren_und_Titelliste").Range("B" & l).Value, Sheets("Bucherfassung").Range("I4")) = 0 Then
MsgBox "nix"
Exit Sub
klappt nicht...
Liebe Grüße
Kerstin
Anzeige
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 15:37:00
onur

If Instr...... > 0 Then
MsgBox Sheets....
Else
MsgBox "nix"
End If

AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 16:00:34
Kerstin
Das hatte ich auch schon probiert... Die Rückgabe ist dabei leider IMMER "Nix" auch, wenn eigentlich etwas gefunden sein sollte...
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 16:09:20
onur
Wenn immer "nix" kommt, hast du einen Fehler in
If InStr(1, Sheets(..........

Poste doch mal den KOMPLETTEN neuen Code oder besser noch die (Beispiels-) Datei.
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 17:29:21
Kerstin
Das war schon der komplette Code... ich muß ihn noch abändern, aber erst mal muß das "Else" klappen...
Sub vergleichen()
Dim l As Long
For l = 1 To 5000
Sheets("Autoren_und_Titelliste").Select
If InStr(1, Sheets("Autoren_und_Titelliste").Range("B" & l).Value, Sheets(" _
Bucherfassung").Range("I4"), vbTextCompare) > 0 Then
MsgBox Sheets("Autoren_und_Titelliste").Range("B" & l).Value & "  *   " & Range("B"  _
& l).Offset(0, -1) & " gefunden"
'            Else
'            MsgBox "nix"
'            Exit Sub
End If
Next
End Sub

Da ich keine Dateien hier hochladen kann (ist alles ausgegraut) hier der Link zu meiner Dropbox:
https://www.dropbox.com/s/tqt6ye2oz7jrhx1/01TestHerberMappe1.xlsm?dl=0
Hoffe, es klappt...
Nochmal zum Verständnis: es muss weder der erste noch der zweite Code sein. Wenn Du eine andere Möglichkeit kennst, den Buchtitel auch in Zellen zu finden, in denen er ZUSAMMEN mit anderen Texten steht, habe ich kein Problem damit ;)
Liebe Grüße
Kerstin
Anzeige
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 17:46:45
onur
Exit Sub
ist schon mal Murks, dann steigt der Code doch schon bei der ersten Zeile aus - du willst doch alle Zeilen durchchecken.
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 18:02:07
Kerstin
Jaaaaa, aber wenn ich Exit Sub NICHT eingebe, kommt gefühlt 1000 mal die MsgBox 'Nix'
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 18:04:04
onur
Dann ist aber dein Code murks, weil er auch genauso 1000 mal "gefunden" ausgeben würde.
Wann soll er denn "gefunden" und wann "nix" ausgeben ?
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 18:26:11
onur

Sub vergleichen()
Dim found
Dim l As Long
With Sheets("Autoren_und_Titelliste")
.Select
With .Range("B" & l).Value
For l = 1 To 5000
If InStr(1, .Value, Sheets("Bucherfassung").Range("I4"), vbTextCompare) > 0 Then
found = .Value
MsgBox .Value & "  *   " & Range("B" & l).Offset(0, -1) & " gefunden"
End If
Next
End With
End With
If found = "" Then MsgBox "nix"
End Sub

Anzeige
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 18:32:27
onur
Wozu hast du denn all die Rechtecke in Zeile 4 eingebaut?
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 20:39:57
Kerstin
Ist doch völlig egal!
Nur zur Info: in der Original-Datei habe ich den Rechtecken Codes zugeordnet!
Zurück zu meinem eigentlichen Problem: WIE STELLE ICH ES AN, DASS DER TITEL AUS "BUCHERFASSUNG" in irgendeiner Zusammensetzung in "Autoren_und'_Titelliste" gefunden wird?
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 20:41:53
onur
Spar dir die Scheiss-Ausrufezeichen !!!
Was ist mit dem Code, das ich gepostet hatte ?
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 21:24:05
Kerstin
Meckert bei:
With .Range("B" & l).Value
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 21:33:33
onur
Sorry - mein Fehler:
Sub vergleichen()
Dim found
Dim l As Long
Sheets("Autoren_und_Titelliste").Select
For l = 1 To 5000
With Sheets("Autoren_und_Titelliste").Range("B" & l)
If InStr(1, .Value, Sheets("Bucherfassung").Range("I4"), vbTextCompare) > 0 Then
found = .Value
MsgBox .Value & "  *   " & Range("B" & l).Offset(0, -1) & " gefunden"
End If
End With
Next
If found = "" Then MsgBox "nix"
End Sub

Anzeige
AW: Wiederholungsschleife mit Platzhaltern
31.05.2020 23:56:41
Kerstin
Suuuper(!!!!)
Jetzt klappt es (!)
Vielen Dank(!)
Schönen Abend noch,
Kerstin

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige