Filterkriterium aus Makro entfernen
28.07.2014 13:26:51
Christian
Franz, alias FCS hatte mir mal nachfolgendes Makro erstellt, ich suche jetzt fast dasselbe Makro, mit der Ausnahme, dass jede Zeile angezeigt werden soll, die einen der selektierten Texte in Spalte B hat, nicht wie bislang nur die Zeilen, die auch einen Inhalt in Spalte F haben.
Ist jemand bitte so nett und nimmt die Bedingung für Spalte F aus dem folgenden Makro raus, sodass nur noch die Bedingung für Spalte B gilt?
Sub Filtern_Spalte_B_und_F()
'Filtert im Autofilter im aktiven Blatt die Daten nach den Werten selektierten Zellen _
in Spalte B und allen nicht leeren Zeilen in Spalte F an
Dim arrFilter(), intJ As Integer, rngSelection As Range, rngZelle As Range
Dim wks As Worksheet
On Error GoTo Fehler
Set wks = ActiveSheet
Set rngSelection = Selection
'Werte in selektierten Zellen in Daten-Array sammeln
For Each rngZelle In rngSelection
If rngZelle.Column = 2 Then
intJ = intJ + 1
ReDim Preserve arrFilter(1 To intJ)
arrFilter(intJ) = rngZelle.Value
End If
Next
If intJ > 0 Then
With wks
'Prüfen, ob Autofilter aktiv/Filter gesetzt
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
If Not .Cells(2, 1) = "F_01" Then
.Rows(2).Insert shift:=xlShiftDown
For intJ = 1 To .UsedRange.Columns.Count
.Cells(2, intJ) = "F_" & Format(intJ, "00")
Next
End If
.UsedRange.AutoFilter
End If
'Autofilter neu setzen
.AutoFilter.Range.AutoFilter Field:=2, Criteria1:=arrFilter, Operator:=xlFilterValues
.AutoFilter.Range.AutoFilter Field:=6, Criteria1:=""
End With
Else
MsgBox "In Spalte B wurden keine Zellen selektiert!", _
vbOKOnly, "Makro: Filtern_Spalte_B_und_F"
End If
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& "Aktuell selektiertes Objekt ist vermutlich keine Zelle!"
End Select
End With
End Sub