AW: Daten filtern
06.04.2008 17:50:34
fcs
Hallo Leitz,
hier die Pozedur mit zusätzlicher Prüfung, ob mehr als ein Name im Bereich D3:D22 eingetragen ist.
Gruß
Franz
Sub TestAutofilter()
Dim strBearbeiter As String, bolBearbeiter As Boolean
Dim objBereich As Range, objZelle As Range
'Prüfen, ob in Spalte D verschiedene Mitarbeiter eingetragen sind
Set objBereich = Range("D3:D22")
For Each objZelle In objBereich
If objZelle "" Then
If strBearbeiter = "" Then
'Mitarbeiter aus 1. ausgefüllter Zelle merken
strBearbeiter = objZelle.Value
Else
If objZelle.Value strBearbeiter Then
'Mitarbeiter ist verschieden vom gemerkten Mitarbeiter
bolBearbeiter = True
Exit For
End If
End If
End If
Next
If bolBearbeiter = True Then 'mehrere Mitarbeiter sind in Liste
'Eingabe Auswahlbuchstabe Bearbeiter
strBearbeiter = InputBox(Prompt:="Bitte Kennbuchstaben für Bearbeiter eingeben" _
& vbLf & vbLf & "Wildcards * (für alle) und ? (für beliebiges Zeichen) " _
& " können verwendet werden!", _
Title:="Werkzeugauswahl - Filter Bearbeiter")
If strBearbeiter = "" Then 'Abbrechen wurde gewählt
ActiveWorkbook.Save
Exit Sub
End If
End If
'Selektiere alle nichtleeren Zellen in Spalte "K" = "Ausgangsdatum" und zähle Auswahl
Dim intZähleAuswahl As Integer
Range("A2:K22").Select
Selection.Autofilter
Range("A2").Select
Selection.Autofilter Field:=11, Criteria1:=""
If bolBearbeiter = True Then
Selection.Autofilter Field:=4, Criteria1:=strBearbeiter
End If
intZähleAuswahl = Application.WorksheetFunction.Subtotal(3, [K3:K22])
'Fehlerabfrage
'...