|
Nimm mal den Code in eine leere Mappe.
Anschließend kopierst Du die nachfolgende Tabelle in das erste Arbeitsblatt dieser Mappe.
Dann lässt Du den Code ablaufen.
Der Code markiert dir jene Datensätz, die Deinen Filterkriterien entsprechen.
Melde Dich, wenn Du das Ergebnis gesehen hast ...
Option Explicit
Sub FilterA()
Dim wks As Excel.Worksheet: Set wks = ActiveSheet
Dim rng As Excel.Range, rngFiltrat As Excel.Range
Dim arr(4) As String
Dim lngRow As Long
Dim i As Long
'Letzte Zelle ermitteln
Set wks = ThisWorkbook.Worksheets(1)
With wks
lngRow = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
.Cells(.Rows.Count, 1).End(xlUp).Row, _
.Cells(.Rows.Count, 1).Row)
End With
'
'Filter zurücksetzen
With wks
'Filter...
If .AutoFilterMode Then .AutoFilterMode = False
'Objektvariable (kann man sich auch einsparen)
Set rng = .Range(.Cells(1, 1), .Cells(lngRow, 1))
End With
'Deine Bedingungen
arr(0) = ""
arr(1) = "<> 0"
arr(2) = "<>Test*"
arr(3) = "<>Versuch*"
For i = 0 To UBound(arr)
'Filter setzen
rng.AutoFilter Field:=1, Criteria1:=arr(i), Operator:=xlFilterValues
Set rngFiltrat = Intersect(rng.SpecialCells(xlCellTypeVisible), rng.SpecialCells(xlCellTypeVisible).Offset(1, 0))
If Not rngFiltrat Is Nothing Then rngFiltrat.Offset(0, 1).Value = "x"
Set rngFiltrat = Nothing
Next
'
Set rng = Nothing: Set wks = Nothing
End Sub
|
Überschrift |
|
Test1 |
|
Test 2 |
|
Versuch |
|
Versuch 3 |
|
0 |
|
1 |
|
xxxxx |
|
xxxxx |
|
|
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|
xxxxx |
|