Mehrere Kriterien übereinstimmen/suchen vba

Question

Guten Tag,

Ich habe meinen Kopf versucht, herauszufinden, wie man eine Suche mit mehreren Kriterien auf mehreren Arbeitsblättern programmieren.

Ich habe 3 ws, die Daten in Zeile a: Datum hat, Zeile b: Zeichenfolge, Zeile c: Betrag. Mein Ziel ist es, Duplikate auf allen drei Blättern zu finden, die in Spalte b und c genau übereinstimmen. Die resultierenden Übereinstimmungen sollten auf ein neu erstelltes Blatt kopiert werden.

Das ist, was ich bisher versucht habe:

Dim WS As Worksheet, WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet 
Dim st_cell As Range, frow1 As Range, frow2 As Range, frow3 As Range, mydata As Range, cell As Range, Descr1 As Range, Descr2 As Range, Descr3 As Range 
Dim p As Long 

Set WS1 = ThisWorkbook.Sheets(2) 
Set WS2 = ThisWorkbook.Sheets(3) 
Set WS3 = ThisWorkbook.Sheets(4) 

    Sheets.Add after:=Sheets(Sheets.Count) 
    Sheets(ActiveSheet.Name).Name = "Report" 
    Sheets("Report").Range("A1") = "Description" 
    Sheets("Report").Range("B1") = "Amount" 
    erow = Sheets("Report").Cells(1, 1).CurrentRegion.Rows.Count + 1 



    Set st_cell = WS1.Cells(2, 2) 
     lastrow = WS1.Cells(WS1.Rows.Count, st_cell.Column).End(xlUp).row 


    Set frow1 = WS2.Cells(2, 2) 
     lastrow1 = WS2.Cells(WS2.Rows.Count, frow1.Column).End(xlUp).row 


    Set frow2 = WS3.Cells(2, 2) 
     lastrow2 = WS3.Cells(WS3.Rows.Count, frow2.Column).End(xlUp).row 


    With WS1 
    For i = 2 To lastrow 
     Set Descr1 = WS1.Range(Cells(i, 2), Cells(i, 3)) 


    For Each Descr1 In ThisWorkbook.Worksheets 
        If (Descr1 <> Empty) Then 
    For p = 2 To lastrow1 And lastrow2 
     Set Descr2 = WS2.Range(Cells(p, 2), Cells(p, 3)) 
     Set Descr3 = WS3.Range(Cells(p, 2), Cells(p, 3)) 

        Set mydata = WS1.Range(Cells(i, 2), Cells(i, 3)).Find(what:=Descr1, after:=.Cells(i, 2), LookIn:=xlValues, lookat:=xlWhole) 
       If Not mydata Is Nothing Then 
        Sheets("Report").Cells(erow, 1) = WS1.Cells(i, "b") 
        Sheets("Report").Cells(erow, 2) = WS1.Cells(i, "c") 
        Exit Sub 
       End If 
    Next p 
    End If 
    Next Descr1 


Next i 
End With 

End Sub 

Wenn es läuft bekomme ich einen Fehler: Arbeitsblatt außerhalb des Bereichs liegt. Bitte helfen Sie.

Vielen Dank im Voraus.

Answer 1

Wenn Sie nur 3 Blätter haben, ist die Zeile Set WS3 = ThisWorkbook.Sheets(4) falsch, da Sie das vierte Blatt referenzieren. Wenn Sie ein viertes Arbeitsblatt haben möchten, sollten Sie die Methode Worksheets.Add verwenden. Um zu sehen, wie Sie diese Funktion entsprechend Ihren Anforderungen verwenden können, lesen Sie Microsoft site.