Microsoft 365 Recherche de valeurs

Stéfane

XLDnaute Occasionnel
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.
 

Pièces jointes

  • RECHERCHE VALEURS.xlsm
    23.3 KB · Affichages: 1
Solution
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 :
20231018_222241.gif

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

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

Pièces jointes

  • RECHERCHE VALEURS.xlsm
    29.4 KB · Affichages: 3

Stéfane

XLDnaute Occasionnel
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.
 

Pièces jointes

  • RECHERCHE VALEURS.xlsm
    34.7 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
312 935
Messages
2 093 738
Membres
105 805
dernier inscrit
belgacem.nahali