Suchfunktion erstellen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Suchfunktion erstellen
von: Manfred
Geschrieben am: 16.11.2003 14:06:22

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
Bild


Betrifft: AW: Suchfunktion erstellen
von: WernerB.
Geschrieben am: 16.11.2003 16:39:41

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).


Bild


Betrifft: AW: Suchfunktion erstellen
von: Manfred
Geschrieben am: 16.11.2003 18:21:41

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


Bild

Beiträge aus den Excel-Beispielen zum Thema " Suchfunktion erstellen"