Attribute VB_Name = "Modul1" Dim treffer As New Collection Dim zaehler As Integer 'Position genau HINTER dem Treffer 'durch rpos=0 und cpos=1 gesetzt! 'Treffer in Spalte iv erzeugen einen Fehler! 'dazu müßten die Konstanten oder der Code 'angepaßt werden! Const rpos = 0 Const cpos = 1 Sub Eing_suchen() Dim z As Range Dim s0 As Range Dim r As Range, r1 As Range Const yesmsgbox As Boolean = False 'collection leeren! Set treffer = Nothing Set s0 = Selection On Error GoTo nicht_gefunden t = InputBox("Gewünschte Menge eingeben", "Eingänge suchen") For i = 1 To s0.Columns.Count Set z = s0.Columns(i) 'selection findet dieses Element nicht, 'darum wird Zeile1 extra überprüft! If yesmsgbox Then MsgBox z.Address If Cells(z.Row, z.Column).Formula = t Then r1 = Cells(z.Row, z.Column) Else Set r1 = z.Find(What:=t, LookIn:=xlFormulas, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=True) End If If yesmsgbox Then MsgBox r1.Address If Not r1 Is Nothing Then treffer.Add r1 'Schleife über alle weiteren Zellen Set r = z.FindNext(r1) 'füge gefundene zur Collection hinzu While r.Address <> r1.Address treffer.Add r If yesmsgbox Then MsgBox r.Address Set r = z.FindNext(r) Wend End If nicht_gefunden: Resume next_line next_line: Select Case treffer.Count 'Fehler oder keine Treffer Case 0: If i = s0.Columns.Count Then MsgBox "Fehler oder nichts gefunden!" Exit Sub End If 'es gab treffer gehe zum ersten Case Else: If i = s0.Columns.Count Then MsgBox treffer.Count & " Treffer gefunden!" zaehler = 1 treffer(1).Offset(rpos, cpos).Select End If End Select Next i End Sub Sub gehe_zum_naechsten() 'gehe immer um einen Treffer weiter nach hinten zaehler = zaehler + 1 If zaehler <= treffer.Count Then If yesmsgbox Then MsgBox treffer(zaehler).Address treffer(zaehler).Offset(rpos, cpos).Activate Else MsgBox "Fertig!" zaehler = 0 End If End Sub Sub gehe_zum_vorherigen() 'gehe immer um einen Treffer weiter nach vorn zaehler = zaehler - 1 If zaehler > 0 Then If yesmsgbox Then MsgBox treffer(zaehler).Address treffer(zaehler).Offset(rpos, cpos).Activate Else MsgBox "Fertig!" zaehler = treffer.Count + 1 End If End Sub