Plusieurs critères de correspondance/recherche vba

Question

Bonjour,

Je me bats la tête en essayant de comprendre comment programmer une recherche multicritère sur plusieurs feuilles de calcul.

J'ai 3 ws qui a des données sur la ligne a: date, ligne b: chaîne, ligne c: montant. Mon but est de trouver des doublons sur les trois feuilles qui correspondent exactement aux colonnes b et c. Les correspondances résultantes doivent être copiées sur une feuille nouvellement créée.

C'est ce que je l'ai essayé jusqu'à présent:

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 

Lors de l'exécution, j'obtiens une erreur: la feuille de travail est hors de portée. S'il vous plaît aider.

Merci d'avance.

Answer 1

Si vous avez seulement 3 feuilles, la ligne Set WS3 = ThisWorkbook.Sheets(4) est erronée, comme vous référencez la quatrième feuille. Si vous voulez avoir une quatrième feuille de calcul, vous devez utiliser la méthode Worksheets.Add. Pour obtenir une vue claire sur la façon d'utiliser cette fonction en fonction de vos besoins, reportez-vous à la section Microsoft site.