VBA Filter erweitern
27.07.2017 13:07:09
Sepp
mit diesem Code, Filtere ich wenn ich Spalte F meine Fehler ( "Daten prüfen").
Jetzt möchte ich noch dazu, dass er auch noch den Filter setzt wenn ein Wert 0 in Spalte C vorhanden ist
Das heißt der Filter muss kommen bei Daten prüfen ( Spalte F ) und bei Spalte C wenn Wert 0 ist.
Sub FehlerUndSuchen()
Dim wks As Worksheet
Dim objButton As Object
Dim lngNumber As Variant
Set wks = ActiveSheet
Set objButton = wks.OLEObjects("Cmd_rot").Object
Select Case objButton.Caption
Case "Alle anzeigen"
'If wks.AutoFilterMode Then wks.ShowAllData
If wks.FilterMode = True Then
wks.AutoFilterMode = False
End If
objButton.Caption = "Filter"
Case "Filter"
Select Case MsgBox("Nach was soll gefiltert werden?" & vbLf & vbLf _
& "Ja = Fehlersuche" & vbLf _
& "Nein = Nach Kundennummer suchen" & vbLf _
& "Abbrechen = Nicht Filtern", vbYesNoCancel + vbQuestion, "Abfrage")
Case vbYes
'wks.Range("A1").CurrentRegion.AutoFilter Field:=6, Criteria1:=RGB(255, 0, 0), _
Operator:=xlFilterCellColor, VisibleDropDown:=False
wks.Range("A2").CurrentRegion.AutoFilter Field:=6, Criteria1:="Daten prüfen", _
Operator:=xlAnd, VisibleDropDown:=False
objButton.Caption = "Alle anzeigen"
Case vbNo
Suchen_Nummer:
lngNumber = Application.InputBox("Bitte FAG Kundennummer eingeben", "fehler", Type:= _
1)
If Not lngNumber = False Then
If IsNumeric(Application.Match(lngNumber, wks.Columns(1), 0)) Then
wks.Range("A2").CurrentRegion.AutoFilter Field:=1, Criteria1:=lngNumber, _
Operator:=xlAnd, VisibleDropDown:=False
objButton.Caption = "Alle anzeigen"
Else
If MsgBox("Bitte prüfen!" & vbLf & vbLf & "Neuer Versuch?", 52, _
"fehler") = vbYes Then
GoTo Suchen_Nummer
End If
End If
End If
Case vbCancel
'do nothing
End Select
Case Else
MsgBox "Fehler bei der Beschriftung der Schaltfläche"
objButton.Caption = "Alle anzeigen"
End Select
End Sub
Danke