Hallo,
ich hab eine Userform mit verschiedenen Textboxen für Kriterien erstellt, leider funktioniert der Filter nicht wie geplant.
Der Filter für den Ort klappt prima.
Allerdings für die Praemie klappt er nicht.
Ich möchte Beispielsweise in den Textboxen folgendes schreiben:
Praemie: >10
praemie1:<51
Mein Code:
Private Sub CommandButton1_Click()
Dim boFund As Boolean
Dim loLetzte As Long
Dim OrtA, OrtB, OrtC, OrtD As String
Dim praemieA, praemieB, praemieC, praemieD As String
Application.ScreenUpdating = False
With Worksheets("Blatt1")
'## Ermitteln der letzten belegten Zelle in Spalte A
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
'## Variablen mit den Daten aus den Textboxen füllen
OrtA = Me.Ort
OrtB = Me.Ort1
OrtC = Me.Ort2
OrtD = Me.Ort3
praemieA = Me.Praemie
praemieB = Me.praemie1
Blatt3.Range("A3:W" & loLetzte).ClearContents
'## Wenn gefiltert, dann alle Daten anzeigen
If .AutoFilterMode Then .AutoFilter.ShowAllData
'## Autofilter setzen
'Blatt1.Range("A1:W" & loletze).AutoFilter
.Range("$A$1:$W$" & loLetzte).AutoFilter
'## Wenn Werte in den Variablen, dann danach filtern
If Not OrtA = vbNullString Then
strKriterium = OrtA & "," & OrtB & "," & OrtC
.Range("$A$1:$W$" & loLetzte).AutoFilter Field:=6, Criteria1:=Split(strKriterium, ","),Operator:=xlFilterValues
boFund = True
End If
'Ab hier funktioniert der Filter nicht.
If Not praemieA = vbNullString Then
strKriterium = praemieA & "," & praemieB
.Range("$A$1:$W$" & loLetzte).AutoFilter Field:=14, Criteria1:=Split(strKriterium, ","), Operator:=xlAnd
voFund = True
End If
If Worksheets("Blatt1").AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
MsgBox "Suchbegriff nicht gefunden"
If .AutoFilterMode Then .AutoFilterMode = False
Exit Sub
Else
With .AutoFilter.Range
If boFund Then
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
Worksheets("Blatt3").Cells(3, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
boFund = False
End If
End With
End If
If .AutoFilterMode Then .AutoFilterMode = False
End With
'## Userform schließen
Unload Me
Application.ScreenUpdating = True
End Sub
Für jede Hilfe wäre ich sehr dankbar :-)
|