Microsoft 365 Recherche de valeurs

Stéfane · 18 Octobre 2023

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 :

VB:

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 · 18 Octobre 2023

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.

sylvanu · 18 Octobre 2023

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 :

VB:

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 · 18 Octobre 2023

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 · 18 Octobre 2023

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 · 18 Octobre 2023

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.

Microsoft 365 Recherche de valeurs

Stéfane

XLDnaute Occasionnel

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

Stéfane

XLDnaute Occasionnel

Pièces jointes

sylvanu

XLDnaute Barbatruc

Stéfane

XLDnaute Occasionnel

Discussions similaires