[VBA] - Recherche sur plages croisées

Bonjour,

J'essaie de récupérer des informations en croisant deux plages de données.

Une première recherche retrouve l'information contenue dans la cellule de la colonne A (A3 par exemple) sur une autre feuille. Lorsque les lignes qui correspondent à ce résultat sont trouvées, une seconde opération recherche le numéro inscrit en ligne 2 colonne B (feuille2) dans la colonne D de la feuille 1.

Je ne sais pas comment être clair dans ma demande... Et puis je n'ai pas nécessairement besoin d'appliquer une méthode particulière pour arriver au résultat espéré.

Petit détail, la feuille 1, dans laquelle la recherche doit se faire, comporte des cellules fusionnées. Il est possible de faire un code pour les défusionner pendant la recherche des infos, si besoin.

Dans le document que je joins à ce post, il y a les deux tableaux pour la recherche, la feuille 2 correspond au résultat que j'obtiens avec mon code, la feuille 3 le résultat que j'espère atteindre.

J'ai rajouté des zones de texte pour mieux expliquer ce que je cherche à faire.

Je joins mon code et mes différents tests, si besoin.

Dim im As Worksheet, lrim&
Dim plageimpacts As Range, plagebota As Range, re As Range, re2 As Range, b%

Set bi = Worksheets("CNPN (Bilan impacts)")
Set im = Worksheets("VNEI (impacts)")
lrbi = bi.Cells(Rows.Count, 1).End(xlUp).Row
lcbi = bi.Cells(1, bi.Columns.Count).End(xlToLeft).Column
lrim = im.Cells(Rows.Count, 4).End(xlUp).Row

 'Compléter les cellules "impact"
    Set plagebota = im.Range("A2:A" & lrim)
    Set plageimpacts = im.Range("D2:D" & lrim)
'    With bi
'        For b = 2 To lcbi - 1
'            Set re2 = plageimpacts.Find(Left(.Cells(2, b), 1), lookat:=xlPart)
'            If Not re2 Is Nothing Then
'                 For a = 3 To lrbi
'                    Set re = plagebota.Find(.Cells(a, 1), lookat:=xlPart)
'                    If Not re Is Nothing Then
'                        .Cells(a, b) = re.Offset(, 3)
'                    Else
'                        .Cells(a, b) = "-"
'                    End If
'                Next a
'            End If
'        Next b
'    End With

    With bi
        For a = 3 To lrbi
            Set re = plagebota.Find(.Cells(a, 1), lookat:=xlPart)
            If Not re Is Nothing Then
                For b = 2 To lcbi - 1
                    Set re2 = plageimpacts.Find(Left(.Cells(2, b), 1), lookat:=xlPart)
                    If Not re2 Is Nothing Then
                        .Cells(a, b) = Mid(re.Offset(, 3), 6)
                    Else
                        .Cells(a, b) = "-"
                    End If
                Next b
            End If
        Next a
    End With
End Sub

Je vous remercie pour votre attention,

Bonne journée !

Salut Le Drosophile,

à tester

Sub tester()
Dim im As Worksheet, lrim&
Dim plageimpacts As Range, plagebota As Range, re As Range, re2 As Range, b%

Set bi = Worksheets("CNPN (Bilan impacts)")
Set im = Worksheets("VNEI (impacts)")
lrbi = bi.Cells(Rows.Count, 1).End(xlUp).Row
lcbi = bi.Cells(1, bi.Columns.Count).End(xlToLeft).Column
lrim = im.Cells(Rows.Count, 4).End(xlUp).Row

 'Compléter les cellules "impact"
    Set plagebota = im.Range("A2:A" & lrim)
    Set plageimpacts = im.Range("D2:D" & lrim)

    With bi
        For a = 3 To lrbi
            Set re = plagebota.Find(.Cells(a, 1), lookat:=xlPart)
            If Not re Is Nothing Then
                For b = 2 To lcbi - 1

                    Set re2 = plageimpacts.Find(Left(.Cells(2, b), 1), lookat:=xlPart)
                    If Not re2 Is Nothing Then
                        .Cells(a, b) = Mid(re.Offset(, 3).Offset(b - 2), 6)
                    Else
                        .Cells(a, b) = "-"
                    End If

                Next b
                re.Offset(, 8).Copy
                .Cells(a, lcbi).PasteSpecial (xlPasteValues)
                .Cells(a, lcbi).PasteSpecial (xlPasteFormats)
                Application.CutCopyMode = False

            End If
        Next a
    End With
End Sub

Bon dimanche

Bonjour,

Les premiers tests sont concluants ! Merci beaucoup pour votre aide

En plus la solution que vous proposez est plutôt simple à comprendre, je pourrai donc réutiliser ce code aisément plus tard, lorsque des situations similaires se présenteront.

Merci beaucoup

Bonne fin de week-end !