Hilfe bei Suchmakro

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

Betrifft: Hilfe bei Suchmakro
von: Annette
Geschrieben am: 12.12.2003 07:49:53

Hallo

Bin leider noch völliger VBA-Laie, vielleicht kann mir jemand ein bißchen weiterhelfen
Ich habe folgendes Suchmakro, das prima funktioniert:


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:=xlPart, _
         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


Nur zwei Dinge würden mir noch fehlen:
Wenn ich bei der Eingabemaske auf Abbrechen klicke, sucht es trotzdem erstmal einen Eintrag, erst ein weiterer Klick auf Nein beendet die Suche. Kann man es auch so einrichten, daß bei Abbrechen das Eingabefeld direkt geschlossen wird?

Außerdem wäre es schön, wenn man nach beendeter Suche und der Meldung "Keine neue Fundstelle" automatisch wieder auf die Ausgangsseite zurück gelangt, um von dort aus ggf. eine neue Suchabfrage starten zu können.

Wäre das machbar?

LG Annette
Bild


Betrifft: AW: Hilfe bei Suchmakro
von: WernerB.
Geschrieben am: 12.12.2003 08:09:50

Hallo Annette,

mal ungetestet:

Sub MultiSeek()
   Dim wks As Worksheet
   Dim rng As Range
   Dim sAddress As String, sFind As String, BlaNa As String
   sFind = InputBox("Bitte Suchbegriff eingeben:")
   If sFind = "" Then Exit Sub
   BlaNa = ActiveSheet.Name
   For Each wks In Worksheets
      Set rng = wks.Cells.Find( _
         what:=sFind, _
         lookat:=xlPart, _
         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!"
    Sheets(BlaNa).Select
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: Hilfe bei Suchmakro
von: Annette
Geschrieben am: 12.12.2003 08:27:16

Hallo Werner

Funktioniert wunderbar, ich bin begeistert! Und dann noch Express-Antwort:-)

Tausend Dank

Annette


Bild

Beiträge aus den Excel-Beispielen zum Thema " einzelne Tabelle speichern"