Clever-Excel-Forum

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 ?

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.

Ok Vielen DANK für die Hilfe, funktioniert

AndyExcel77

atilla

AndyExcel77