VBA Loop Worksheet Filter mit mehreren Variablen

Question

Ich versuche, eine einfache Suche Registerkarte für einige meiner Mitarbeiter bereitzustellen, damit sie leicht durch eine große Datentabelle für bestimmte Einträge filtern und kopieren Sie die Zeile aus der Master-Liste und Vergangenheit in den Suchbereich

Der Code unten funktioniert tatsächlich und kopiert die Daten aus den übereinstimmenden Einträgen, leider "Land" ist das einzige Kriterium, das funktioniert und der Rest nichts tun.

Ich versuche, den Code zu optimieren, den ich geschrieben habe, um alle Kriterien zum Funktionieren zu bringen, und wenn die Kriterien in der entsprechenden Suche leer sind, ignoriert es die Kriterien, die erlauben, dass irgendein Wert in dieser Zelle kopiert und eingefügt wird. Ich dachte, das Hinzufügen von If Else-Anweisungen für alle Kriterien würde den Job erledigen, aber ich bin mir nicht sicher, wie ich die If Else-Anweisung in VBA für alle Strings richtig hinzufügen und sie auffordern soll, die Kriterien zu ignorieren, wenn sie leer ist.

Sub search_and_extract_multicriteria() 
 

 
Dim datasheet As Worksheet 'where is the data copied from 
 
Dim reportsheet As Worksheet 'where is the data pasted to 
 
Dim country As String 
 
Dim SubType As String 
 
Dim ProductName As String 
 
Dim ProductFormula As String 
 
Dim Source As String 
 
Dim Rating As String 
 
Dim finalrow As Integer 
 
Dim i As Integer 'row counter 
 

 
Set datasheet = Sheet1 
 
Set reportsheet = Sheet3 
 
country = reportsheet.Range("A3").Value 
 
SubType = reportsheet.Range("C3").Value 
 
ProductName = reportsheet.Range("D3").Value 
 
ProductFormula = reportsheet.Range("E3").Value 
 
Source = reportsheet.Range("F3").Value 
 
Rating = reportsheet.Range("G3").Value 
 

 
reportsheet.Range("A16:K500").ClearContents 
 

 
datasheet.Select 
 
'finalrow = Cells(Row.Count, 1).End(x1Up).Row 
 

 
For i = 2 To 500 'finalrow 
 
    If Cells(i, 1) = country And Cells(i, 3) = SubType And Cells(i, 4) = ProductName And Cells(i, 5) = ProductFormula And Cells(i, 6) = Source And Cells(i, 2) = TestimonialType And Cells(i, 9) = Rating Then 
 
     Range(Cells(i, 1), Cells(i, 11)).Copy 'copy columns 1 to 11 (A to K) 
 
     reportsheet.Select 
 
     Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats 
 
     datasheet.Select 
 
     End If 
 
Next i 
 

 
reportsheet.Select 'this is so that the report sheet is selected when the procedure ends 
 

 
End Sub

Answer 1

Statt einer Schleife, wie etwa nur den in AutoFilter Einbau unter Verwendung von nach der Überprüfung, dass der Variable mit einem Istwert aufgefüllt wird.

With datasheet.Range(.Range("A1"), .Cells(500, 11)) 

    If Len(country) Then .AutoFilter 1, country 
    If Len(TestimonialType) Then .AutoFilter 2, TestimonialType 
    If Len(SubType) Then .AutoFilter 3, SubType 
    If Len(ProductName) Then .AutoFilter 4, ProductName 
    If Len(ProductFormula) Then .AutoFilter 5, ProductFormula 
    If Len(Source) Then .AutoFilter 6, Source 
    If Len(Rating) Then .AutoFilter 9, Rating 

    .Offset(1).SpecialCells(xlCellTypeVisible).Copy 'offset 1 to remove header row 
    reportsheet.Range("A200").End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats 

    .AutoFilter 'reset filter 

End With