Hallo zusammen,
ich stehe vor einem kleinen Problem bezüglich meiner Suchfunktion. Die Zelle B1 dient als Eingabefeld für die Suchfunktion. Durch bestätigen von Enter werden alle Zeilen ohne eingegebenen Wert ausgeblendet (bspw. Lieferanten). Nun das Problem: will man direkt einen neuen Lieferanten suchen, geht dies nicht ohne die Zelle B1 zu löschen (Backspace + Enter). Ansonsten sucht man innerhalb der schon gefilterten Zeilen nochmal weiter.
Meine Frage: ist es möglich die Zelle B1 nach dem Drücken der Enter-Taste "zurückzusetzen"? Also so, dass man nicht mehr innerhalb der angezeigten Ergebnisse sucht, sondern sich die Suche direkt wieder auf das ganze Tabellenblatt bezieht?
Komme ich irgendwie hiermit weiter:
'Zelle nach der Eingabe leeren
Cells(Target.Row, Target.Column).Clear
Ich hänge euch mal meinen Code dran, vielleicht kann mir ja jemand helfen :)
Vielen Dank schonmal vorab!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strFirst As String
Dim lngColumn As Long
Dim rngUnion As Range
Dim rngFound As Range
Dim rngTMP As Range
Dim lngRow As Long
On Error GoTo Fin
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
If Trim(Target.Value) = "" Then _
Cells.EntireRow.Hidden = False: Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
lngRow = IIf(Len(Cells(Rows.Count, 1)), Rows.Count, _
Cells(Rows.Count, 1).End(xlUp).Row)
lngColumn = Cells.Find _
("*", , , , xlByColumns, xlPrevious).Column
Set rngTMP = Range(Cells(3, 1), Cells(lngRow, lngColumn))
Set rngFound = rngTMP.Find(Cells(1, 2).Text, _
After:=Range("A3"), LookIn:=xlValues, LookAt:=xlPart)
If Not rngFound Is Nothing Then
strFirst = rngFound.Address
Do
If Not rngUnion Is Nothing Then
Set rngUnion = Application.Union(rngUnion, _
Cells(rngFound.Row, 1)).EntireRow
Else
Set rngUnion = Cells(rngFound.Row, 1).EntireRow
End If
Set rngFound = rngTMP.FindNext(rngFound)
Loop While rngFound.Address <> strFirst
Else
Target.ClearContents
MsgBox "Nothing found!"
End If
Else
Exit Sub
End If
Application.Goto Range("B1")
If Not rngUnion Is Nothing Then
rngTMP.Rows.Hidden = True
rngUnion.Hidden = False
End If
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
Application.ScreenUpdating = True
Application.EnableEvents = True
Set rngUnion = Nothing
Set rngFound = Nothing
Set rngTMP = Nothing
End Sub
|