Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
184to188
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
184to188
184to188
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro zum Suchen eines Begriffes abändern!

Makro zum Suchen eines Begriffes abändern!
25.11.2002 17:51:55
Oliver S.
Hallo,

ich brauche mal Hilfe zu einem Makro. Ich habe ein Makro um Einträge in einem Tabellenblatt zu finden, also eine Suchfunktion. Das funktioniert. Jetzt mein Problem, da einige Suchbegriffe, es handelt sich hier um Straßennamen, doppelt vorkommen, wird natürlich nur der erste Begriff gefunden. Gibt man danach den Begriff erneut ein, wird wieder nur die erste Übereinstimmung gefunden. Jetzt wäre es schön, wenn bei dem ersten gefundenen Begriff eventuell eine Abfrage kommt, ob es sich um den gesuchten Eintrag handelt. Diese müsste dann mit ja, die Suchfunktion wird beendet, oder mit nein, die Suchfunktion wird weiter fortgeführt, bestätigt werden.

Hier der Code:

Private Sub Suchen_Click()
Unload Me
Dim strSuche As String
Dim erg As Range
strSuche = InputBox("Mindenstens die 2 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
Do While Len(strSuche) <
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
strSuche = InputBox("Mindestens die 2 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
Loop
Set erg = Range("A4:R500").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False) If erg Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, oder suchen Sie den Begriff manuell in der Tabelle."
Exit Sub
Else
Range(erg.AddressLocal).Activate
Exit Sub
End If
End Sub

Wer kann mir eventuell den vorhanden Code so abändern, das meine Wünsche dort mit eingearbeitet werden?

Danke für die Mühe,
Oliver

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

Betreff
Datum
Anwender
Anzeige
Re: Makro zum Suchen eines Begriffes abändern!
25.11.2002 19:27:48
M. Kuhn
Moin Oliver,

etwa so; die Columns & Rows sind auf "R500" bezogen, evtl. anpassen. Das ganze ist nich reentrant, also per SF und nicht per _Change-Ereignis rufen!

Sub WorksheetStrSearch()

Dim strSuche As String
Dim strLastFoundAdr As String
Dim erg As Range

Cells(4, 1).Activate

While ActiveCell.Row < 500 And ActiveCell.Column < 18
If strSuche = "" Then
strSuche = InputBox("Mindenstens die 2 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
Else
strSuche = InputBox("Weitersuchen?", "Suchen", strSuche)
End If
Set erg = Range(ActiveCell.AddressLocal, "R500").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, oder suchen Sie den Begriff manuell in der Tabelle."
Exit Sub
Else
If strLastFoundAdr = erg.AddressLocal Then
MsgBox "Keine weiteren Entsprechungen gefunden"
Exit Sub
Else
strLastFoundAdr = erg.AddressLocal
Range(erg.AddressLocal).Activate
End If
End If
Wend

End Sub

MfG Mario

Anzeige
Soweit super, aber kleines Problem!
25.11.2002 19:42:37
Oliver S.
Danke Mario,

soweit ist das schon so wie ich es mir vorgestellt hatte. Nur gibt es jetzt das Problem, wenn eine Übereinstimmung gefunden wurde, die dem Entspricht was ich gesucht habe und ich auf Abrechen klicke, wird der Suchvorgang fortgesetzt. Es wird dann in leeren Zeilen weitergesucht. Eigentlich sollte doch mit der Abbrechen-Taste der Suchvorgang beendet werden.
Woran kann das liegen?

Wenn Du mir da noch helfen könntest, wäre ich Dir dankbar.

Trozdem noch mal danke,
Oliver

Re: Soweit super, aber kleines Problem!
25.11.2002 19:45:19
Nepumuk
Hallo Oliver,

versuch es mal so:

Private Sub Suchen_Click()
Unload Me
Dim strSuche As String, erg As Range, firstAddress As String, gefunden() As String
Dim index1 As Integer, index2 As Integer, text As String, schalter As Integer
schalter = 4
text = "Weiter anzeigen ?"
Do
strSuche = InputBox("Mindestens die 2 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 1
Set erg = Range("A4:R500").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, oder suchen Sie den Begriff manuell in der Tabelle."
Else
firstAddress = erg.Address
Do
index1 = index1 + 1
ReDim Preserve gefunden(1 To index1)
gefunden(index1) = erg.Address
Set erg = Range("A4:R500").FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
Do
index2 = index2 + 1
If index2 = index1 Then
text = ""
schalter = 0
End If
Range(gefunden(index2)).Select
ActiveWindow.ScrollRow = Selection.Row
ActiveWindow.ScrollColumn = Selection.Column
If MsgBox(CStr(index2) & ". von " & CStr(index1) & " gefundenen Sätzen." & vbNewLine & text, schalter, "Anzeige") = 7 Then Exit Do
If index2 = index1 Then Exit Do
Loop
End If
End Sub

Gruß
Nepumuk

Anzeige
Soweit super, aber kleines Problem!
25.11.2002 19:56:56
Oliver S.
Danke Mario,

soweit ist das schon so wie ich es mir vorgestellt hatte. Nur gibt es jetzt das Problem, wenn eine Übereinstimmung gefunden wurde, die dem Entspricht was ich gesucht habe und ich auf Abrechen klicke, wird der Suchvorgang fortgesetzt. Es wird dann in leeren Zeilen weitergesucht. Eigentlich sollte doch mit der Abbrechen-Taste der Suchvorgang beendet werden.
Woran kann das liegen?

Wenn Du mir da noch helfen könntest, wäre ich Dir dankbar.

Trozdem noch mal danke,
Oliver

Re: Soweit super, aber kleines Problem!
25.11.2002 19:59:13
M. Kuhn
Moin Oliver,

jeweils nach dem Aufruf der InputBox die Zeile:

If vbCancel Then Exit Sub

einfügen.

MfG Mario

Anzeige
Es funktioniert, super und danke!
25.11.2002 20:02:12
Oliver S.
Danke Nepumuk,

das ist ja super. Ist ja sogar mehr als ich erwartet hatte. Es funktióniert super.

Nochmal besten Dank für Eure Hilfe,
Oliver

Arbeitet nich korrekt
25.11.2002 20:06:15
Nepumuk
Hallo Oliver Hallo Mario
irgendetwas passt noch nicht an dem Code. Der findet bei mit nur vier von sieben Einträgen im angegebenen Bereich.
Gruß
Nepumuk

Re: Arbeitet nich korrekt
25.11.2002 20:16:26
Oliver S.
Hi Nepumuk,

also bei mir werden alle Einträge gefunden. Auch die Anzahl der gefundenen Einträge stimmt mit der in der Tabelle vorhandenen Einträgen.

MfG,
Oliver

Re: Arbeitet nich korrekt
25.11.2002 20:18:49
Nepumuk
Hallo Oliver,
ich hab damit den Code von Mario gemeint. Der hat bei mir nicht alle Einträge gefunden.
Gruß
Nepumuk
Anzeige
Re: Arbeitet nicht korrekt
25.11.2002 21:13:46
M. Kuhn
Hallo Nepumuk und Oliver,

Dank für den Hinweis, nach dem Abendbrot geht alles besser, ich habe das Sub jetzt 2-fach geändert:

1. SearchOrder schaltet sich am Zeilenende um;
2. das ganze läuft in einer Zeilen-Schleife (schneller wg. abs. Adressierung).

Zielbereich wird im Kopf eingestellt, MaxSpalte bitte Suchgrenze +1.

Sub WorksheetStrSearch()

Dim strSuche As String
Dim strLastFoundAdr As String
Dim erg As Range
Dim i As Integer
Dim MaxSpalte As String, MaxZeile as Long

MaxSpalte = "S500" : MaxZeile = 500
Cells(4, 1).Activate

For i = 4 To MaxZeile

If strSuche = "" Then
strSuche = InputBox("Mindenstens die 2 ersten Buchstaben des Suchbegriffes oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If vbCancel = 2 Then Exit Sub
Else
strSuche = InputBox("Weitersuchen?", "Suchen", strSuche)
If vbCancel = 2 Then Exit Sub
End If
Set erg = Range(ActiveCell.AddressLocal, MaxSpalte).Find(what:=strSuche, searchorder:=xlByRows, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, oder suchen Sie den Begriff manuell in der Tabelle."
Exit Sub
Else
If erg.AddressLocal = strLastFoundAdr Then
Set erg = Range("A" & ActiveCell.Row + 1, MaxSpalte).Find(what:=strSuche, searchorder:=xlByColumns, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If erg Is Nothing Then Exit For
strLastFoundAdr = erg.AddressLocal
Range(erg.AddressLocal).Activate
Else
strLastFoundAdr = erg.AddressLocal
Range(erg.AddressLocal).Activate
End If
End If

Next i

MsgBox "Bereich komplett durchsucht, keine weitere Entsprechung gefunden!"

End Sub

Fehler bitte posten. Viele Grüße Mario

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige