Clever-Excel-Forum

Hallo,

ich habe folgende Suchfunktion bei mir per Schaltfläche zum Aktivieren als Code

Sub Suchfunktion()
   Dim bFound As Boolean
   Dim rC As Range
   Dim tAddr As String
   Dim tSearch As String
   tSearch = InputBox("Suche nach:", "Suchen")
   If tSearch = "" Then Exit Sub
   With ActiveSheet.Cells
       Set rC = .Find(tSearch, LookIn:=xlValues)
       If Not rC Is Nothing Then
           tAddr = rC.Address
           Do
               rC.Select
               rC.Interior.ColorIndex = 4
               MsgBox "Artikel:" & rC.Value
               rC.Interior.ColorIndex = 2
               bFound = True
               Set rC = .FindNext(rC)
           Loop While Not rC Is Nothing And rC.Address <> tAddr
       End If
   End With
   If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"
End Sub


Ich würde noch gerne das die Suchergebnisse zusammen in einer List box stehen und mir angezeigt werden ( dazu sollen die werte in den nebenstehenden Zeilen auch angezeigt werden)


also im Beispiel unten sollen die Inhalte von  B12 und C12 sowie D12 mit in der List box angezeigt werden
Also in meiner Tabelle immer die Spalten B C und d nebenstehend

Ist das möglich ?

Hallo,

mal ungetestet (sollte zumindest für B12 und C12 klappen)

Hallo,

und danke

Ich habe noch ein Problem,

wenn ich die Suchfunktion aktiviere, kann ich Sie nicht abbrechen bis alle Ergebnisse angezeigt wurden!

Bitte um abhilfe

hier noch mal der Code ->

Sub Suchfunktion()
   Dim bFound As Boolean
   Dim rC As Range
   Dim tAddr As String
   Dim tSearch As String
   tSearch = InputBox("Suche nach:", "Suchen")
   If tSearch = "" Then Exit Sub
   With ActiveSheet.Cells
       Set rC = .Find(tSearch, LookIn:=xlValues)
       If Not rC Is Nothing Then
           tAddr = rC.Address
           Do
               rC.Select
               rC.Interior.ColorIndex = 4
               MsgBox "Artikel:" & rC.Value
               rC.Interior.ColorIndex = 2
               bFound = True
               Set rC = .FindNext(rC)
           Loop While Not rC Is Nothing And rC.Address <> tAddr
       End If
   End With
   If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"
End Sub

Hallo,

If MsgBox("Artikel:" & rC.Value, vbRetryCancel) = vbCancel Then Exit Do

Gruß Uwe

(14.12.2016, 07:43)Kuwer schrieb: [ -> ]Hallo,

If MsgBox("Artikel:" & rC.Value, vbRetryCancel) = vbCancel Then Exit Do

Gruß Uwe

Hallo, das klappt super , nur leider lässt er mir die Ergebnisse farbig stehen, wenn ich auf abbrechen klicke, das müsste noch behoben werden, DANKE

Hallo, das klappt super , nur leider bleiben die Suchergebnisse Farbig eingefärbt, wenn ich auf abrechen klicke, das müsste noch behoben werden.

DANKE

Hallo,

stimmt, also doch etwas umfangreicher:

Sub Suchfunktion()

  Dim bFound As Boolean, bCancel As Boolean

  Dim rC As Range

  Dim tAddr As String

  Dim tSearch As String

  tSearch = InputBox("Suche nach:", "Suchen")

  If tSearch = "" Then Exit Sub

  With ActiveSheet.Cells

      Set rC = .Find(tSearch, LookIn:=xlValues)

      If Not rC Is Nothing Then

          tAddr = rC.Address

          Do

              rC.Select

              rC.Interior.ColorIndex = 4

              bCancel = MsgBox("Artikel:" & rC.Value, vbRetryCancel) = vbCancel

              rC.Interior.ColorIndex = 0

              bFound = True

              Set rC = .FindNext(rC)

          Loop While Not rC Is Nothing And rC.Address <> tAddr And Not bCancel

      End If

  End With

  If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"

End Sub

Gruß Uwe

Super Vielen DANK !!!

Das mit der List box öffne ich noch einmal neu das ist dann wohl auch umfangreicher

DANKE