Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1836to1840
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Filterkriterium nicht erfüllt

Filterkriterium nicht erfüllt
09.07.2021 23:53:26
Peter
Hallo,
hat einer eine Idee, warum mir mein Code alle Datensätze kopiert, wenn eines der beiden geforderten FIlterkriterium nicht erfüllt ist? Solange er beide Kriterien in der Liste findet, klappt es. Leider nicht, wenn eines nicht erfüllt ist. Es müssen beide Filterkriterien erfüllt sein, dann sollte der Datensatz in seinen Bereich kopiert werden, ansonsten eben nicht.
Hier der Code:
Option Explicit

Private Sub Worksheet_activate()
Dim i As Long, ws As Worksheet, strDatum As String, daDatum As Date
Dim Suchkriterium As String
Dim RangeZiel As String
Application.ScreenUpdating = False
If ActiveSheet.Name Like "##.##.####" Then
strDatum = ActiveSheet.Name
daDatum = ActiveSheet.Name
With Worksheets("Einsatzprotokolle")
For i = 1 To 5
'             .Range("C5").AutoFilter
If i = 1 Then Suchkriterium = "Frühdienst"
If i = 1 Then RangeZiel = "AE4:BB13"
If i = 2 Then Suchkriterium = "Spätdienst"
If i = 2 Then RangeZiel = "AE16:BB25"
If i = 3 Then Suchkriterium = "Nachtdienst"
If i = 3 Then RangeZiel = "AE28:BB37"
If i = 4 Then Suchkriterium = "Zusatzdienst 1"
If i = 4 Then RangeZiel = "AE40:BB49"
If i = 5 Then Suchkriterium = "Zusatzdienst 2"
If i = 5 Then RangeZiel = "AE52:BB61"
If WorksheetFunction.CountIf(.Columns("D"), daDatum) > 0 Then
.Range("C5").AutoFilter Field:=2, Criteria1:=strDatum
.Range("C5").AutoFilter Field:=5, Criteria1:=Suchkriterium
With ActiveSheet
.Range(RangeZiel).ClearContents
With Worksheets("Einsatzprotokolle").AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Columns("A:Z").Copy
End With
.Range(RangeZiel).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
.Range("C5").AutoFilter
End If
Next
.Range("C5").AutoFilter
End With
End If
Application.CutCopyMode = False
End Sub

Danke für Eure Hilfe

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Filterkriterium nicht erfüllt
10.07.2021 09:50:50
Werner
Hallo,
wenn der Filter kein Ergebnis liefert, dann besteht die Filterrange aus allen vorhandenen Daten und somit wird auch alles kopiert.
Du mußt vor dem Kopiervorgang prüfen, ob der Filter ein Ergebnis geliefert hat oder nicht. Und nur wenn ein Filterergebnis vorliegt, dann auch kopieren.

Private Sub Worksheet_Activate()
Dim i As Long, ws As Worksheet, strDatum As String, daDatum As Date
Dim Suchkriterium As String, RangeZiel As String
Application.ScreenUpdating = False
If ActiveSheet.Name Like "##.##.####" Then
strDatum = ActiveSheet.Name
daDatum = ActiveSheet.Name
With Worksheets("Einsatzprotokolle")
For i = 1 To 5
.Range("C5").AutoFilter
If i = 1 Then Suchkriterium = "Frühdienst"
If i = 1 Then RangeZiel = "AE4:BB13"
If i = 2 Then Suchkriterium = "Spätdienst"
If i = 2 Then RangeZiel = "AE16:BB25"
If i = 3 Then Suchkriterium = "Nachtdienst"
If i = 3 Then RangeZiel = "AE28:BB37"
If i = 4 Then Suchkriterium = "Zusatzdienst 1"
If i = 4 Then RangeZiel = "AE40:BB49"
If i = 5 Then Suchkriterium = "Zusatzdienst 2"
If i = 5 Then RangeZiel = "AE52:BB61"
If WorksheetFunction.CountIf(.Columns("D"), daDatum) > 0 Then
.Range("C5").AutoFilter Field:=2, Criteria1:=strDatum
.Range("C5").AutoFilter Field:=5, Criteria1:=Suchkriterium
'Prüfen ob der Filter ein Ergebnis liefert
If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
With ActiveSheet
.Range(RangeZiel).ClearContents
With Worksheets("Einsatzprotokolle").AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Columns("A:Z").Copy
End With
.Range(RangeZiel).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
End If
End If
Next i
End With
End If
Application.CutCopyMode = False
End Sub
Gruß Werner
Anzeige
Danke Werner, hat geklappt owT
10.07.2021 16:05:17
Peter
Danke Werner, hat geklappt. Dann ist natürlich klar, warum dann alle abgebildet werden.
Gerne u. Danke für die Rückmeldung. o.w.T.
10.07.2021 20:08:28
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige