Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngFilter As Range, c As Range
Dim lngDate As Long, strTarget As String
Dim arrFilter() As Variant, x As Long
'in Zeile 2 ?
If Intersect(Target, Range("B2:E2")) Is Nothing Then Exit Sub
'zu filternder Bereich nach Vorgabe ab "B3:E3" abwärts
Set rngFilter = Range(Cells(3, 2), Cells(Rows.Count, 2).End(xlUp))
Set rngFilter = rngFilter.Resize(rngFilter.Rows.Count, 4)
'Zelle leer ? oder
If Target.Value = "" Then
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
Else
'wo wurde
Select Case Target.Column
Case 2
'einen Filter nach Teileingabe aufbauen
ReDim arrFilter(1 To rngFilter.Columns(1).Cells.Count)
strTarget = Trim(CStr(Target.Value))
For Each c In rngFilter.Columns(1).Cells
If InStr(CStr(c.Value), strTarget) > 0 Then
x = x + 1
arrFilter(x) = CStr(c.Value)
End If
Next c
'jetzt filtern
rngFilter.AutoFilter Field:=Target.Column - 1, _
Criteria1:=Array(arrFilter), Operator:=xlFilterValues
Case 3, 4
'normal
rngFilter.AutoFilter Field:=Target.Column - 1, Criteria1:=Target.Value
Case 5
'Datumsspalte nach gültigen Datum
If IsDate(Target.Value) = False Then Exit Sub
lngDate = CLng(Target.Value)
rngFilter.AutoFilter Field:=Target.Column - 1, _
Criteria1:=">=" & lngDate, _
Operator:=xlAnd, Criteria2:="<" & lngDate + 1
End Select
End If
End Sub
|