Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Suchfunktion erstellen

Forumthread: Suchfunktion erstellen

Suchfunktion erstellen
16.11.2003 14:06:22
Manfred
Hallo,
ich möchte eine Suchfunktion in eine Arbeitsmappe mit mehreren Tabellen einfügen. Ich habe es mit folgendem Code versucht. Das Problem ist, es werden nicht alle Tabellen abgesucht und wenn ein Treffer gefunden wurde, wird die betreffene Zelle automatisch als erste Zelle oben links angezeigt. Ich hätte aber gerne, dass alle Tabellen durchsucht und das das Ergebnis mitten im Bildschirm angezeigt wird, oder zumindest genau dort, wo es sich auf der Tabelle befindet. So, hier der Code:


Sub MultiSeek()
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set rng = wks.Cells.Find( _
what:=sFind, _
lookat:=xlWhole, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
If MsgBox( _
prompt:="Weiter", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then Exit Sub
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub



Ich muß auch nicht genau diesen Code verwenden, wenn es eine viel einfachere Lösung gibt, wäre ich natürlich dankbar für alle Info´s.

MfG
Manfred
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchfunktion erstellen
16.11.2003 16:39:41
WernerB.
Hallo Manfred,

genügt dieses leicht modifizierte Makro Deinen Ansprüchen?

Sub MultiSeek()
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox(vbCr & vbCr & "Bitte Suchbegriff eingeben:", _
"Eingabe Suchbegriff")
If sFind = "" Then Exit Sub
For Each wks In Worksheets
Set rng = wks.Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
Application.Goto Reference:=Range("A1"), Scroll:=True
Range(rng.Address).Select
If MsgBox("Soll die Suche fortgesetzt werden ?", _
vbYesNo + vbQuestion, "Frage an " & _
Application.UserName & ":") = vbNo Then Exit Sub
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Next wks
MsgBox "Es gibt keine neue Fundstelle !", vbYes + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
End Sub

Viel Erfolg wünscht
WernerB.

P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter (siehe Forums-FAQ).
Anzeige
AW: Suchfunktion erstellen
16.11.2003 18:21:41
Manfred
Vielen, vielen Dank für die superschnelle Antwort. Hab´s eben mal kurz ausprobiert und es sieht bis jetzt sehr gut aus und funktioniert!!!

!!! DANKE !!!

Grüße Manfred
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige