Wort suchen in Spalten

Sub Suchen() Dim Suchbegriff$ On Error GoTo Fehler Suchbegriff = InputBox("bitte Suchbegriff eingeben", , "") If StrPtr(Suchbegriff) = 0 Then Exit Sub Suchbegriff = "" & Suchbegriff & "" Cells.Find(What:=Suchbegriff, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart).Activate weiter: Cells.FindNext(After:=ActiveCell).Activate If MsgBox("Weiter suchen?", vbYesNo, " Sie haben gesucht nach: -> " & _ Suchbegriff) = vbYes Then GoTo weiter Exit Sub Fehler: MsgBox "Leider kein Treffer" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Suchen() Dim Suchbegriff$, erste$, c As Range, r As Range, s As Range, at% Suchbegriff = InputBox("bitte Suchbegriff eingeben", , "") If StrPtr(Suchbegriff) = 0 Then Exit Sub Set s = ActiveCell Set r = Columns("A") at% = xlWhole weiter: Set c = r.Find(Suchbegriff$, after:=Cells(1, r.Column), _ lookat:=at%, LookIn:=xlFormulas, MatchCase:=False, searchorder:=xlByColumns) If Not c Is Nothing Then erste$ = c.Address Do c.Activate If MsgBox("Weiter suchen?", vbYesNo, " Sie haben gesucht nach: -> " & _ Suchbegriff) = vbNo Then Exit Sub Set c = r.FindNext(c) Loop Until c.Address = erste$ at% = xlPart Set r = Range("B:H") If Range(erste$).Column = 1 Then GoTo weiter Else s.Activate End If End If Set c = Nothing: Set r = Nothing: Set s = Nothing End Sub

Hallo Piet / Gerd,
erstmal danke für eure Geduld mit meiner umständlichen Erklärung.
Piet: "wie ist bitte dieser Satz zu verstehen? - Bei Text(Wort)suche schliesst sich das Suchfenster und es geschied nichts mehr."
... Bei Zahl-Eingabe arbeitet der Makro den Code ab. Bei Text-Eingabe schliesst sich das Suchfenster und es wird keine Suche durchgeführt.
Piet: "Soll nach dem finden einer Zahl oder Text in A bei den Spalten B bis H ein anderes Wort gesucht werden? Das ist mir jetzt unklar!"
...Nein, der eingegebene Suchbegriff bleibt für alle Spalten gleich.
Neuer Anlauf:
In Spalte "A" soll der Suchbegriff nur in ganzen Zellen abwärts gesucht werden.
In den Spalten "B - H" soll der gleiche Suchbegriff auch in Stichwörtern abwärts gefunden werden.
mfg Speedy

Sub Suchen() Dim Suchbegriff$, erste$, c As Range, r As Range Suchbegriff = InputBox("bitte Suchbegriff eingeben", , "") If Suchbegriff = Empty Then Exit Sub Set r = Columns("A") Set c = r.Find(What:=Suchbegriff, After:=Cells(1, 1), LookIn:=xlValues, _ LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False) If Not c Is Nothing Then 'Rangebereich in B bis H ab gefundener Zelle Set r = Range("B" & c.Row & ":H" & Rows.Count) Set c = r.Find(What:=Suchbegriff, After:=Cells(c.Row, 2), LookIn:=xlValues, _ LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False) erste$ = c.Address Do c.Activate 'MsgBox mit gefundenem Wert If MsgBox(c.Value & Chr(10) & "Weiter suchen?", vbYesNo, _ " Suche: -> " & Suchbegriff) = vbNo Then Exit Sub 'MsgBox ohne gefundenen Wert 'If MsgBox("Weiter suchen?", vbYesNo, " Suche: -> " _ & Suchbegriff) = vbNo Then Exit Sub Set c = r.FindNext(c) Loop Until c.Address = erste$ End If Set c = Nothing: Set r = Nothing MsgBox "Suchen Ende" End Sub

Hallo Speedy
mein Fehler, ich dachte in Spalte A soll nicht mehr gesucht werden. Probier bitte mal den neuen Code.
Dabei kommt mir jetzt im Augenblick eine wichtige Frage. Der neue Code sucht zuerst in der Spalte A den 1. W:ert als xlWhole, ganze Zelle! Dann schalte ich um auf xlPart. Ist das in Ordnung? Oder soll in der Spalte A generell die ganze Zelle gesucht werden, und in Spalte B-H nur Teilwörter.
Dann wird die Suche komplizierter, weil FindNext die Konditionen der vorherigen Suche übernimmt. Bei FindNext kann ich meines Wissens nicht bei der Suche umschalten auf xlWhole oder xlPart! Laesst sich auch programmieren, ist aber schwieriger.
Ich warte mal deine Antwort ab.
mfg Piet

Sub Suchen()
Dim Suchbegriff$, erste$, c As Range, r As Range
Suchbegriff = InputBox("bitte Suchbegriff eingeben", , "")
If Suchbegriff = Empty Then Exit Sub
Set r = Columns("A")
'suche zuerst ganze Zelle in Spalte A
Set c = r.Find(What:=Suchbegriff, After:=Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not c Is Nothing Then
'Scuhlauf umschalten auf xlPart für Spalten A-H
Set c = r.Find(What:=Suchbegriff, After:=Cells(c.Row - 1, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
'Suchbereich von A-H neu festlegen
Set r = Range("A" & c.Row & ":H" & Rows.Count)
erste$ = c.Address   'First gefundene Adresse
Do
c.Activate
'MsgBox mit gefundenem Wert
If MsgBox(c.Value & Chr(10) & "Weiter suchen?", vbYesNo, _
"  Suche: -> " & Suchbegriff) = vbNo Then Exit Sub
'MsgBox ohne gefundenen Wert
'If MsgBox("Weiter suchen?", vbYesNo, "  Suche: -> " _
& Suchbegriff) = vbNo Then Exit Sub
Set c = r.FindNext(c)
Loop Until c.Address = erste$
End If
Set c = Nothing: Set r = Nothing
MsgBox "Suchen Ende"
End Sub

Sub Suchen_neu() Dim Suchbegriff As String, erste$, c As Range, r As Range Suchbegriff = InputBox("bitte Suchbegriff eingeben", , "") If Suchbegriff = Empty Then Exit Sub Set r = Columns("A") 'suche zuerst Suchbegriff in Spalte A (Teil String) Set c = r.Find(What:=Suchbegriff, After:=Cells(1, 1), LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False) 'erweitere den Suchbereich auf Spalten A-H Set r = Range("A" & c.Row & ":H" & Rows.Count) If Not c Is Nothing Then erste$ = c.Address Do '1.Loop für ganze Zelle in A finden If c.Column = 1 And c.Value = Suchbegriff Then Exit Do Set c = r.FindNext(c) Loop Until c.Address = erste$ Do '2. Loop um alle Begriffe in A-H finden c.Activate 'MsgBox mit gefundenem Wert If MsgBox(c.Value & Chr(10) & "Weiter suchen?", vbYesNo, _ " Suche: -> " & Suchbegriff) = vbNo Then Exit Sub 'MsgBox ohne gefundenen Wert 'If MsgBox("Weiter suchen?", vbYesNo, " Suche: -> " _ & Suchbegriff) = vbNo Then Exit Sub Set c = r.FindNext(c) Loop Until c.Address = erste$ End If Set c = Nothing: Set r = Nothing MsgBox "Suchen Ende" End Sub

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wort suchen in Spalten

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread