Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 17:19:09
Formel mit Index-Funktion
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
24.04.2024 14:48:50
"Eingabefeld" zwischen zwei Zeilen geht nicht weg.
24.04.2024 14:40:10
Zeilenumbrüche in Textbox zählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1468to1472
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1468to1472
1468to1472
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Such-Makro modifizieren

Such-Makro modifizieren
21.01.2016 12:05:06
Wolfango
Hallo zusammen,
untenstehenden VBA-Code verwende ich zum Durchsuchen einer Spalte.
Nun benötige ich zwei Erweiterungen:
1. Es sollen nicht nur exakte Treffer angezeigt werden, sondern auch Zellen bei denen der Suchbegriff Bestandteil des Zellinhalts ist (zB: Suchbegriff: Hamburg; Treffer bei Hamburger Hafen).
2. Aktuell ist es so:
Wird der Suchbegriff gar nicht gefunden, erscheint die Meldung "Suchbegriff nicht gefunden". Leider erscheint keine Meldung wenn der Suchbegriff gefunden wurde, man anschließend die "Weiter suchen?"-Frage mit OK bestätigt und infolge kein Fund mehr erfolgt. Schön wäre die Meldung "Sucbegriff kein weiteres Mal gefunden" o.ä..
Danke für's Nachdenken und Gruß,
Wo
Dim rngZelle As Range
Dim strSuchbegriff As String
Dim strStart As String
Dim bytWeiter As Byte
Dim lngLetzte As Long
strSuchbegriff = InputBox("Suchbegriff:")
If strSuchbegriff "" Then
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
With Range(Cells(3, 2), Cells(lngLetzte, 2))
Set rngZelle = .Find(strSuchbegriff, lookat:=xlWhole, LookIn:=xlValues)
If Not rngZelle Is Nothing Then
strStart = rngZelle.Address
Do
Application.Goto reference:=rngZelle, scroll:=True
bytWeiter = MsgBox("Weiter suchen?", vbOKCancel)
If bytWeiter = 2 Then Exit Do
Set rngZelle = .FindNext(rngZelle)
Loop While Not rngZelle Is Nothing And rngZelle.Address strStart
Else
If rngZelle Is Nothing Then MsgBox "Suchbegriff nicht gefunden"
End If
Set rngZelle = Nothing
End With
End If

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Such-Makro modifizieren
21.01.2016 12:30:25
Daniel
Hi
für die Suche nach dem Prinzip "enthält Suchbegriff" kannst du so vorgehen:
Variante a)
bei .Find den Parameter Lookat:=xlPart setzen
dann wird immer mit "enthält" gesucht
Variante b)
die Programmierung so lassen und bei der Eingabe des Suchbegriffs das Jokerzeichen vor und nach dem Suchbegriff mit angeben, dh Suchbegriff "*Hamburg*"
du musst dann zwar die Jokerzeichen mit angeben, kannst aber bei jeder Suche erneut festlegen, ob mit "enthält", "beginnt mit", "endet mit" oder "entspricht genau" gesucht wird.
für die Abschlussmeldung wenn alle Werte gefunden so vorgehen: 
        ...
Set rngZelle = .FindNext(rngZelle)
if rngZelle is nothing or rngZelle.Address = strStart Then
Msgbox "Keine weitern Fundstellen vorhanden"
Exit Do
end if
Loop
Else
...
gruß Daniel

Anzeige
AW: Such-Makro modifizieren
21.01.2016 14:50:37
Wolfango
...vielen Dank!!
Mein erster Wunsch ("enthält Suchbegriff")fuktioniert schon mal!
Zur 2. Frage: Wo exakt muss ich die Zeilen hinkopieren?
Habe verschiedene Varianten probiert, bekomme aber immer wieder Fehlermeldungen.
Danke und Gruß,
Wo

AW: Such-Makro modifizieren
21.01.2016 15:53:08
Daniel
Hi
das ist der Bereich, den du überarbeiten musst:
If bytWeiter = 2 Then Exit Do
Set rngZelle = .FindNext(rngZelle)
Loop While Not rngZelle Is Nothing And rngZelle.Address strStart
 Else
If rngZelle Is Nothing Then MsgBox "Suchbegriff nicht gefunden"
du musst die Abbruchbedingung vom LOOP wegnehmen und als 
IF Abbruchbediung erfüllt THEN
EXTI SUB
END IF

in die Schleife integrieren, damit du die Msgbox mit der Meldung als zusätzliche Befehlzeile mit aufnehmen kannst.
gruß Daniel

Anzeige
AW: Such-Makro modifizieren
21.01.2016 17:35:36
Wolfango
...sorry, aber ich bekomm's nicht hin (kann kein VBA...rate nur...)
Mein Code sieht jetzt wie untenstehend aus. Offensichtlich fehlt noch was?
Danke vorab!
Gruß, Wo
Sub Test()
Dim rngZelle As Range
Dim strSuchbegriff As String
Dim strStart As String
Dim bytWeiter As Byte
Dim lngLetzte As Long
strSuchbegriff = InputBox("gesuchtes Formular?")
If strSuchbegriff  "" Then
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
Count)
With Range(Cells(3, 2), Cells(lngLetzte, 2))
Set rngZelle = .Find(strSuchbegriff, Lookat:=xlPart, LookIn:=xlValues)
If Not rngZelle Is Nothing Then
strStart = rngZelle.Address
Do
Application.Goto reference:=rngZelle, scroll:=True
bytWeiter = MsgBox("Weiter suchen?", vbOKCancel)
If bytWeiter = 2 Then Exit Do
Set rngZelle = .FindNext(rngZelle)
Loop While Not rngZelle Is Nothing And rngZelle.Address  strStart
Else
If rngZelle Is Nothing Then MsgBox "Suchbegriff nicht gefunden"
End If
Set rngZelle = Nothing
End With
End If
End Sub

Anzeige
AW: Such-Makro modifizieren
21.01.2016 17:43:46
Daniel
Hi
sorry, unglaubwürdig.
den bestehenden Code hast du dir sicherlich auch nicht erraten.
irgendwie musst du den ja auch geschrieben haben.
also meinet wegen hier die Do- Schleife, die wirst du ja hoffentlich selbstständig austauschen können:
Do
Application.Goto reference:=rngZelle, scroll:=True
bytWeiter = MsgBox("Weiter suchen?", vbOKCancel)
If bytWeiter = 2 Then Exit Do
Set rngZelle = .FindNext(rngZelle)
if rngZelle is Nothing or rngZelle.Address = strStart then
MsgBox "alles durchsucht."
Exit Do
end If
Loop
Loop While Not rngZelle Is Nothing And rngZelle.Address

Anzeige
AW: Such-Makro modifizieren
22.01.2016 09:38:07
Wolfango
...den Code hatte ich aus dem Netz. Anpassen u. Verändern gelingt dann entweder via Trial a. Error oder mit Hlfe dieses wunderbaren Forums hier!
Und so bin ich leider immer noch nicht am Ziel. Klar kann ich die von Dir beschriebenen Zeilen austauschen. Danke darür!
Aber wie geht's dann weiter? Und wo kommt die letzte von Dir geschriebene Zeile hin?
Ich benötige schon den kompletten Code (da ich Fragmente - wie gesagt - nicht lesen kann).
Das wäre prima!
Mein (zu einer Fehlermeldung führender) Code sieht aktuell wie folgt aus:
Sub Test()
Dim rngZelle As Range
Dim strSuchbegriff As String
Dim strStart As String
Dim bytWeiter As Byte
Dim lngLetzte As Long
strSuchbegriff = InputBox("gesuchtes Formular?")
If strSuchbegriff  "" Then
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
Count)
With Range(Cells(3, 2), Cells(lngLetzte, 2))
Set rngZelle = .Find(strSuchbegriff, Lookat:=xlPart, LookIn:=xlValues)
If Not rngZelle Is Nothing Then
strStart = rngZelle.Address
Do
Application.Goto reference:=rngZelle, scroll:=True
bytWeiter = MsgBox("Weiter suchen?", vbOKCancel)
If bytWeiter = 2 Then Exit Do
Set rngZelle = .FindNext(rngZelle)
If rngZelle Is Nothing Or rngZelle.Address = strStart Then
MsgBox "alles durchsucht."
Exit Do
End If
Loop
Loop While Not rngZelle Is Nothing And rngZelle.Address
End Sub

Anzeige
AW: Such-Makro modifizieren
22.01.2016 13:36:34
Daniel
Hi
pro Do ein Loop.
ist doch nicht so schwer.
wenn ich Schreibe, dass du die Do-Loop-Schleife austauschen sollst und mein Code von Do bis Loop reicht, dann sollte eigentlich klar sein, dass du dann aus deinem Code den Code von der Do- bis zur Loop-Zeile löschen und durch mein Do-Loop ersetzen musst.
dh. du musst auch deine alte Zeile mit dem Loop löschen.
Gruß Daniel

AW: Such-Makro modifizieren
25.01.2016 11:09:52
Wolfango
...super! Jetzt funktionierts! Habe meinen Fehler gefunden!
Vielen Dank!
Jetzt noch ein weiterer Wunsch (erst heute hinzugekommen):
Aktuell durchsucht das Makro die Spalte B nach Text (bzw. Textbestandteilen) .
Das Makro soll nun in einer anderen Tabelle nur die Spalte A durchsuchen und zwar nach Zahlen (bzw. dem Zahlanfang; also bei Eingabe von 6.100 auch die Zahl 6.100.200 finden)
Was muss ich ändern?
Vielen Dank schon mal vorab!
hier mein aktueller Code:
Sub Test()
Dim rngZelle As Range
Dim strSuchbegriff As String
Dim strStart As String
Dim bytWeiter As Byte
Dim lngLetzte As Long
strSuchbegriff = InputBox("gesuchte Dokument-Nr.?")
If strSuchbegriff  "" Then
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
Count)
With Range(Cells(3, 2), Cells(lngLetzte, 2))
Set rngZelle = .Find(strSuchbegriff, Lookat:=xlPart, LookIn:=xlValues)
If Not rngZelle Is Nothing Then
strStart = rngZelle.Address
Do
Application.Goto reference:=rngZelle, Scroll:=True
bytWeiter = MsgBox("Weiter suchen?", vbOKCancel)
If bytWeiter = 2 Then Exit Do
Set rngZelle = .FindNext(rngZelle)
If rngZelle Is Nothing Or rngZelle.Address = strStart Then
MsgBox "Alles durchsucht. Keine weitere Dokument-Nr. gefunden!"
Exit Do
End If
Loop
End If
Set rngZelle = Nothing
End With
End If
End Sub

Anzeige
AW: Such-Makro modifizieren
25.01.2016 15:05:38
otto
Hi,
so findest du auch Teilstrings.
Bereiche und Suchbegriff musst du noch anpassen.
Dim bolmatch, tmp As Variant, index As Integer
tmp = Range("B1:B100")
For index = 1 To UBound(tmp, 1) Step 1
bolmatch = InStr(1, tmp(index, 1), Cells(1, 2), vbTextCompare) > 0
If bolmatch Then MsgBox ("Treffer")
Next
In Cells(1, 2) steht in diesem Fall der Begriff der gesucht werden soll.
Vielleicht kannst du damit was anfangen.
otto

AW: Such-Makro modifizieren
25.01.2016 17:03:51
Wolfango
....Danke!
Aber das Makro muss für meinen Zweck schon exakt das machen, was das gepostete Makro macht.
Nur eben in Spalte A und mit Zahlen.
Gruß, Wo
Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige