Suchfunktion erweitern

[AndyExcel77]

Hallo,

ich habe folgende Suchfunktion bei mir

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.Resize(1, 4).Interior.ColorIndex = 4
              bCancel = MsgBox("Artikel:" & rC.Value, vbRetryCancel) = vbCancel
              rC.Resize(1, 4).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


Ich habe nur das Problem das ich wenn ich einen Treffer habe , ich diesen nicht bearbeiten kann (zb. löschen des Eintrages )

gibt es die Möglichkeit zusätzlich zu abrechen und weiter noch die Funktion Löschen dazu zu fügen ?

[atilla]

Hallo,

eine Möglichkeit:

Code:

Sub Suchfunktion()
  Dim bFound As Boolean, bCancel
  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.Resize(1, 4).Interior.ColorIndex = 4
              bCancel = MsgBox("Artikel:" & rC.Value _
              & vbLf & "zum Löschen Ja klicken" & vbLf & "zum Weitersuchen Nein klicken" & vbLf & "zum Beenden der Suche Abbrechen klicken", vbYesNoCancel)
              rC.Resize(1, 4).Interior.ColorIndex = 0
              Select Case bCancel
                Case 6
                  rC.ClearContents
                Case 2
                  bCancel = True
              End Select
              
              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

Den Text für die Msgbox kannst Du an den entsprechenden Stellen selber anpassen, denke ich.

[AndyExcel77]

Ok Vielen DANK für die Hilfe, funktioniert