AW: Sortierung mittels Eingabefeld
01.03.2018 19:13:44
KlausF
Hallo Werner,
probier mal:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strFirst As String
Dim lastCol As Integer
Dim rngUnion As Range
Dim rngFound As Range
Dim rngTMP As Range
Dim lastRow As Long
On Error GoTo ErrorHandler
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Cells(1, 1)) Is Nothing Then
If Trim(Target.Value) = "" Then Cells.EntireRow.Hidden = False: Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
lastCol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set rngTMP = Range(Cells(3, 1), Cells(lastRow, lastCol))
Set rngFound = rngTMP.Find(Cells(1, 1).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 "Kein Eintrag!"
End If
Else
Exit Sub
End If
Application.Goto Range("A1")
If Not rngUnion Is Nothing Then
rngTMP.Rows.Hidden = True
rngUnion.Hidden = False
End If
ErrorHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Set rngUnion = Nothing
Set rngFound = Nothing
Set rngTMP = Nothing
End Sub
Das Eingabefeld ist A1. Du kannst nach Telefonnummern oder Texten suchen (auch Teilnummern / Teiltexte).
Der Filter setzt sich automatisch zurück wenn die Eingabe gelöscht wird.
Originalcode ist glaube ich von Case (hier aus dem Forum)
https://www.herber.de/bbs/user/120148.xls
Gruß
Klaus