AW: VBA - ZÄHLENWENN gesuchter Text enthalten
21.09.2018 12:34:34
Werner
Hallo,
ja, der bin ich.
Das liegt daran, dass du im ersten Schritt nur die Spalte A filterst, während du beim zweiten Filtern die Spalten A:C filterst.
Außerdem ist der Eintrag in Z3 eine echte Zahl, die du aber in eine Variable vom Typ String packst.
Dann hast du beim zweiten Filter, ein Zahlenfilter, den Joker drin. Erstens brauchst du den Joker hier nicht und zweitens funktioniert der mit dem Zahlenfilter sowieso nicht.
Zudem solltest du dir angewöhnen deine Variablen richtig zu deklarieren.
Du hast das hier:
Dim Model, Typ As String
Hier ist nur die Variable Typ als String deklariert, die Variable Model ist vom Typ Variant, weil der Typ nicht angegeben ist.
Korrekt wäre:
Dim Model As String, Typ As String
Aber wie schon geschrieben in deinem Fall:
Dim Model as String, Typ As Long
Ganzer Code:
Sub Makro1()
Application.ScreenUpdating = False
Dim Modell As String, Typ As Long
Dim loLetzte1 As Long
Dim QD, QP As String
QP = "F:\Bearbeitung\FCA\Import\Source"
QD = Dir(QP & "\*." & "xlsx")
'Set QAM = Workbooks.Open(QP & "\" & QD)
'Set QRB = QAM.Sheets(1)
Set ZRB = ThisWorkbook.Sheets(1)
ZRB.Range("W2:X15").ClearContents
Model = ZRB.Range("$Z$2")
Typ = ZRB.Range("$Z$3")
loLetzte1 = ZRB.Cells(ZRB.Rows.Count, 16383).End(xlUp).Row
If Not Model = vbNullString Then
ZRB.Range("A:C").AutoFilter Field:=1, Criteria1:="*" & Model & "*"
ZRB.Range("A:C").AutoFilter Field:=3, Criteria1:=Typ
If ZRB.Cells(ZRB.Rows.Count, 1).End(xlUp).Row > 1 Then
ZRB.AutoFilter.Range.Offset(1).Resize(ZRB.AutoFilter.Range.Rows.Count - 1).Columns(2). _
SpecialCells(xlCellTypeVisible).Copy
ZRB.Range("XFC1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ZRB.AutoFilterMode = False
loLetzte1 = ZRB.Cells(ZRB.Rows.Count, 16383).End(xlUp).Row
ZRB.Range(ZRB.Cells(1, 16383), ZRB.Cells(loLetzte1, 16383)).RemoveDuplicates Columns:=1, _
Header:=xlNo
loLetzte1 = ZRB.Cells(ZRB.Rows.Count, 16383).End(xlUp).Row
ZRB.Range(ZRB.Cells(1, 16384), ZRB.Cells(loLetzte1, 16384)).FormulaLocal = "=ZÄ _
HLENWENNS(A:A;""*""&$Z$2&""*"";B:B;XFC1;C:C;$Z$3)"
ZRB.Range(ZRB.Cells(1, 16383), ZRB.Cells(loLetzte1, 16384)).Copy
ZRB.Cells(2, 23).PasteSpecial Paste:=xlPasteValues
ZRB.Columns("XFC:XFD").ClearContents
ZRB.Range("A1").Select
Else
MsgBox "Das gesuchte Modell ist nicht vorhanden."
ZRB.AutoFilterMode = False
End If
Else
MsgBox "Es wurde kein Modell in Zelle Z2 angegeben."
End If
Application.ScreenUpdating = True
End Sub
Gruß Werner