Microsoft 365 Recherche de valeurs

[Stéfane]

Bonjour à tous,

Je cherche à simplifier et à rendre plus rapide une macro qui me permet de réaliser une recherche avec condition.
Elle se présente comme cela :

For Each c In ActiveSheet.[J2:J2000]
If c.Value = [U7].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V7]
If c.Value = [U8].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V8]
If c.Value = [U9].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V9]
If c.Value = [U10].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V10]
If c.Value = [U11].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V11]
If c.Value = [U12].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V12]
If c.Value = [U13].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V13]
If c.Value = [U14].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V14]
If c.Value = [U15].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V15]
If c.Value = [U16].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V16]
If c.Value = [U17].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V17]
If c.Value = [U18].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V18]
If c.Value = [U19].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V19]
If c.Value = [U20].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V20]
If c.Value = [U21].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V21]

Cette macro fonctionne mais long à l'exécution du au nombre de lignes.
Je recherche une valeur correspondante à la valeur des cellules U7 à U21 dans une feuille qui à des valeurs x et xx très récurrente afin d'extraire le % 3 colonnes plus loin.
Peut-être avec une boucle ?

Merci pour votre aide.


Pour vous donner une idée ce que je cherche je vous joint un fichier.

 

[sylvanu]

Bonsoir Stéphane,
Vous auriez pu intégrer votre macro à votre PJ, on aurait eu une idée de l'attendu.
Car ex abrupto c'est "un peu flou".
Alors un peu au pif, ceci en PJ :

Sub Test()
    tablo1 = [J2:J2000]
    tablo2 = [P2:P2000]
    tablo3 = [U7:U21]
    tablo4 = [M2:M2000]
    Dim Resultat(1 To 15)
    For i = 1 To UBound(tablo1)
        For j = 1 To UBound(tablo3)
            'If c.Value = [U7].Value And c.Offset(0, 6).Value = "XX" Then c.Offset(0, 3).Copy Destination:=[V7]
            If tablo1(i, 1) = tablo3(j, 1) And tablo2(i, 1) = "CHAUSSURE" Then _
                Resultat(j) = tablo4(i, 1)
        Next j
    Next i
    [V7].Resize(UBound(Resultat), 1).Value = Application.Transpose(Resultat)
End Sub

Comme le résultat doit être probablement erroné, donnez un attendu, ou mieux une PJ complète.

 

[Stéfane]

Bonjour Sylvanu,

Merci pour votre aide.
Comme demandé j'ai intégré ma macro dans mon fichier.
Lorsque je test la votre j'ai une erreur qui m'indique "Tableau attendu"" sur cette ligne For i = 1 To UBound(tablo1)
Je ne voit pas d'où cela vient.

 

[sylvanu]

Bonsoir,
Je ne comprends pas puisqu'on a au dessus tablo1 = [J2:J2000] donc le tableau est défini.
Sur mon PC il n'y a aucun problème :

... et cerise sur le gâteau les résultats sont corrects.

 

[Stéfane]

Re bonsoir Sylvanu,

C'est de ma faute, j'avais mal déclaré les variables tab1, tab2....
Effectivement, cela fonctionne parfaitement !!

Merci encore beaucoup pour votre aide et très bonne soirée.