Erweitertes Suchmakro?

[Calafati]

Hallo zusammen,

ich habe mir beizeiten ein Makro in meine Tabelle eingebaut welches nach Eingabe eines Suchwortes in das betreffende Feld den nächsten Eintrag gleichen Namens sucht, dies allerdings nur einmalig...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$3" Then
Cells.Find(What:=Range("$E$3"), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End If
End Sub

Frage: a) funktioniert das überhaupt, und b) wenn ja WIE müsste man dieses Makro modifizieren, daß auch die folgenden gleichen Einträge gefunden werden?!?

Eine kurze Restwoche wünscht
Klaus

[snb]

Bitte, verwende Code Tags.

[BoskoBiati]

Hallo,

dann suche mal nach "find next"

[Gast 123]

Hallo

da das Makro mit Recorder aufgezeichnet wurde funktioniert.  Anbei eine geaenderte Version wenn man alle Zellen im Blatt anspringen will, mit Abbruch über Cancel, oder Ende wenn Zelle "E3" ereicht wurde. Erscheint -keine MsgBox- gibt es den Begriff nur einmal in der Zelle die angesprungen wird.  

Zum Suchlauf selbst:  "xlPart" heisst Teilwort suchen, "xlWhole" heisst die Zelle muss komplett übereinstimmen.  Gesucht wird hier in Zeilen, will man Spalten von Oben nach unten druchsuchen muss man den Code von "xlByRows" auf "xlByColumns" aendern!  Gross Kleinschreibung ist hier deaktiviert. Sonst muss MatchCase auf True stehen.  Ich erwaehne es nur um zu zeigen das es diesen Suchlauf in mehreren Varianten gibt. 

mfg  Gast 123 

Code:

Dim rFind As Object, ok As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$3" Then
  Cells.Find(What:=Range("$E$3"), After:=ActiveCell, LookIn:=xlFormulas, _
  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  MatchCase:=False, SearchFormat:=False).Activate
 
  If ActiveCell.Address <> Target.Address Then
     Set rFind = Cells.FindNext(ActiveCell)
     If rFind.Address = "$E$3" Then Exit Sub
     Do
        ok = MsgBox(ActiveCell.Address(0, 0), vbOKCancel)
        If ok = vbCancel Then Exit Sub
        Cells.FindNext(ActiveCell).Activate
     Loop Until ActiveCell.Address = "$E$3"
  End If
End If
End Sub

'LookAt:=xlPart, SearchOrder:=xlByRows      sucht Parts im Text in Zeilen
'LookAt:=xlWhole, SearchOrder:=xlByCoumns   sucht -ganzes Wort- in Spalten  

[Calafati]

Hallo Gast123,

das funktioniert ganz prima!
Danke für Deine Mühe!

Viele Grüße
Klaus