formule matricielle trop long d execution

[GHISLAIN]

bonjour a tous ,
voila avec l aide de l excelien "Rachid" il m'a proposé une formule matricielle qui recupere des donnes suivant deux listes de choix
les donnees a recuperer sont sur une autre feuille du classeur et peuvent etre reparties sur plusieurs colonnes

toutefois , la formule proposée est longue d execution et encore plus longue lorsque je l integre dans mon classeur finale

je cherche donc a svoir si par macro nous ne pouvions avoir le meme résultat

ci join t le fichier operationnelle du resultat attentu par formule matricielle

cordialement

ghislain

 

[phlaurent55]

Re : formule matricielle trop long d execution

Bonjour Ghislain,

ton fichier en retour

à+
Philippe

 

[david84]

Re : formule matricielle trop long d execution

Bonsoir, salut Philippe,
je t'ai laissé une proposition sur le 1er fil (pas la peine d'ouvrir 2 discussions sur le même thème).
A+

 

[GHISLAIN]

Re : formule matricielle trop long d execution

bonsoir phlaurent55 , david84

phlaurent55 je viens de regarder ta proposition mais je vois que tu as supprimé une liste de choix dans ta proposition

effectivement dons mon classeur la recherche doit s effectuer sur deux critères pour les colonnes de recherche

le premier étant du texte dans l exemple "bleu" , tilt, vert1 etc........
le second critère est un numéro de série 284, 287 etc..

dans ta proposition tu a seulement effectué la recherche sur les colonnes contenant le choix de la liste de choix de la ligne 5 sans tenir compte du critère de la ligne 6

peux tu me dire comment modifier ta macro pour prendre en compte les deux conditions??

pour david84 , me semblant être un fil différent dans l intitulé , de formule demandant une macro c est le pourquoi je opté poster un nouveau fil qui répondrai mieux a l avenir dans une éventuelle recherche d'internaute a la recherche de macro.

quoi qu il en soit je passe sur mon autre fil voir la proposition que tu m a fait et je t en remercie vivement

cordialement

Ghislain

 

[phlaurent55]

Re : formule matricielle trop long d execution

Re,

'bleu" ayant toujours le même N°
"tilt" ayant toujours le même N°
( dans le fichier joint à ta question

il n'est pas nécessaire de tester le deux cellules

mais si tu le désires, remplace le code par celui-ci

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E4")) Is Nothing Then
    Range("B6:B" & Range("B65535").End(xlUp).Row + 1).ClearContents
ligne = 6
With Sheets("test3")
For i = 3 To .Range("IV5").End(xlToLeft).Column
If .Cells(5, i).Value <> Target And .Cells(6, i).Value <> [E3] Then
GoTo fin
End If
For j = 7 To .Cells(65535, i).End(xlUp).Row
Cells(ligne, 2) = .Cells(j, i)
ligne = ligne + 1
Next j
fin:
Next i
End With
End If
End Sub

la modif concerne cette ligne

If .Cells(5, i).Value <> Target And .Cells(6, i).Value <> [E3] Then

à+
Philippe

 

[GHISLAIN]

Re : formule matricielle trop long d execution

re,

il est vrai que j aurai du préciser que bleu ou autre pouvez avoir un autre numéro , d ou l importance de prendre en compte les deux listes de choix
je viens de tester ta nouvelle proposition , mais celle ci ne tient pas compte du choix de numéro , mais que du bleu etc...

il est inperatif que le choix soit associe a un type (bleu, tilt..) et un numéro (284.287 etcc...)

peux tu , sans abuser de tes compétences , m indiquer ce qui cloche ??

cordialement

ghislain

 

[phlaurent55]

Re : formule matricielle trop long d execution

Re,

voici le fichier avec les modifs répondant à la demande

le temps d'exécution est-il plus rapide qu'avec les formules matricielles ?

à+
Philippe

 

[ROGER2327]

Re : formule matricielle trop long d execution

Bonjour à tous

Sur la base du code de phlaurent55, cela devrait être un poil plus rapide :​

Private Sub Worksheet_Change(ByVal Cible As Range)
Dim ligne&, i&, a, b, c&, CelA As Range, CelB As Range, Plg As Range
    Set Plg = Range("E3:E4") '*** Paramètres de recherche ***
    If Not Intersect(Cible, Plg) Is Nothing Then
        Set CelA = Range("B5") '*** Cellule d'intitulé des résultats ***
        ligne = CelA.Row + 1
        a = Plg(1).Value
        b = Plg(2).Value
        With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual: End With
        With Range(CelA, Cells(Rows.Count, CelA.Column).End(xlUp))
            If .Rows.Count > 1 Then .Resize(.Rows.Count - 1, 1).Offset(1).ClearContents
        End With
        With Sheets("test3") '*** Feuille de données ***
            Set CelB = .Range("C5") '*** Haut gauche de la plage de données ***
            c = CelB.Row + 1
            For i = CelB.Column To .Cells(c - 1, .Columns.Count).End(xlToLeft).Column
                If .Cells(c - 1, i).Value = b And .Cells(c, i).Value = a Then
                    Set Plg = .Range(.Cells(c, i), .Cells(.Rows.Count, i).End(xlUp))
                    If Plg.Rows.Count > 1 Then
                        Set Plg = Plg.Resize(Plg.Rows.Count - 1, 1).Offset(1)
                        Cells(ligne, CelA.Column).Resize(Plg.Rows.Count, 1).Value = Plg.Value
                        ligne = ligne + Plg.Rows.Count
                    End If
                End If
            Next i
        End With
        With Application: .Calculation = xlCalculationAutomatic: .EnableEvents = True: .ScreenUpdating = True: End With
    End If
End Sub

ROGER2327
#5838

Vendredi 13 Palotin 139 (Esquive de Saint Léonard da V, illusioniste - fête Suprême Quarte)
13 Floréal An CCXX, 3,4745h - bâton-d'or
2012-W18-3T08:20:20Z

 

[GHISLAIN]

Re : formule matricielle trop long d execution

Bonjour phlaurent55, ROGER2327

je viens de tester vos deux propositions qui toute deux répondent a ma recherche et la finalisation de mon projet

pour le code de ROGER2327 si les valeurs n existent pas j ai une erreur , j ai donc rajouté On Error Resume Next

juste avant If Not Intersect(Cible, Plg) Is Nothing Thenet la solution fonctionne

je vous remercie tout deux de votre excellente proposition et il est vrai que rien n est comparable en vitesse d execution par rapport a des formules matricielles


bon weekend a tous

merci encore de votre aide

cordialement

Ghislain

 

[ROGER2327]

Re : formule matricielle trop long d execution

Re...

(...)
pour le code de ROGER2327 si les valeurs n existent pas j ai une erreur , j ai donc rajouté On Error Resume Next

juste avant If Not Intersect(Cible, Plg) Is Nothing Thenet la solution fonctionne
(...)

De quelles valeurs parlez-vous ? Chez moi, le code fonctionne même si la feuille test3 est vide.

Merci de me répondre : j'aime bien savoir pourquoi un code ne fonctionne pas.​

ROGER2327
#5855

Jeudi 19 Palotin 139 (Occultation de Saint Gauguin, océanique - fête Suprême Quarte)
19 Floréal An CCXX, 3,2210h - arroche
2012-W19-2T07:43:49Z

 

[GHISLAIN]

Re : formule matricielle trop long d execution

bonjour a tous ,
pour ROGER2327 si ma plage de recherche , en l occurrence E3:E4 il me mettait une erreur d excution13 , pour contourner le problème j ai donc rajouter le on error resume next

pour moi probleme resolu tout fonctionne

merci a tous de votre aide et collaboration

cordialement

Ghislain

 

[ROGER2327]

Re : formule matricielle trop long d execution

Bonjour à tous

À GHISLAIN : merci pour votre réponse.
Je n'ai pas réussi à reproduire l'erreur que vous signalez, mais si vous avez trouvé une solution, c'est sans importance.

(Personnellement, je n'aime pas beaucoup masquer un défaut du code par On Error Resume Next, surtout lorsque le défaut n'est pas clairement identifié. Mais c'est affaire de goût.)

J'ai profité de l'occasion pour vérifier le code. Je lui apporte quelques corrections pour le traitement d'éventuelles colonnes vides.​

Private Sub Worksheet_Change(ByVal Cible As Range)
Dim ligne&, i&, a, b, c&, CelA As Range, CelB As Range, Plg As Range, x
    Set Plg = Range("E3:E4") '*** Paramètres de recherche ***
    If Not Intersect(Cible, Plg) Is Nothing Then
        Set CelA = Range("B5") '*** Cellule d'intitulé des résultats ***
        ligne = CelA.Row + 1
        a = Plg(1).Value
        b = Plg(2).Value
        With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual: End With
        With Range(CelA, Cells(Rows.Count, CelA.Column).End(xlUp))
            If .Rows.Count > 1 Then .Resize(.Rows.Count - 1, 1).Offset(1).ClearContents
        End With
        With Sheets("test3") '*** Feuille de données ***
            Set CelB = .Range("C5") '*** Haut gauche de la plage de données ***
            c = CelB.Row + 1
            For i = CelB.Column To .Cells(c - 1, .Columns.Count).End(xlToLeft).Column
                If .Cells(c - 1, i).Value = b And .Cells(c, i).Value = a Then
                    Set Plg = .Range(.Cells(c, i), .Cells(oMax(c - 1, .Cells(.Rows.Count, i).End(xlUp).Row), i))
                    If Plg.Rows.Count > 1 Then
                        If Not IsEmpty(Plg(2)) Then
                            Set Plg = Plg.Resize(Plg.Rows.Count - 1, 1).Offset(1)
                            Cells(ligne, CelA.Column).Resize(Plg.Rows.Count, 1).Value = Plg.Value
                            ligne = ligne + Plg.Rows.Count
                        End If
                    End If
                End If
            Next i
        End With
        With Application: .Calculation = xlCalculationAutomatic: .EnableEvents = True: .ScreenUpdating = True: End With
    End If
End Sub

Private Function oMax(x&, y&)
    oMax = ((x + y) + Abs(x - y)) / 2
End Function

ROGER2327
#5856

Jeudi 19 Palotin 139 (Occultation de Saint Gauguin, océanique - fête Suprême Quarte)
19 Floréal An CCXX, 6,8983h - arroche
2012-W19-2T16:33:21Z

 

[GHISLAIN]

Re : formule matricielle trop long d execution

re ROGER2327,

je te remercie et je teste ta dernière proposition ,
pour moi néophyte dans excel c etait la solution bateau du on resume next , qui me permettait d eviter l erreur , mais il est vrai qu il vaut mieux identifier le probleme
je te remercie en tout cas de l interet porté a mon fil

tres cordialement

ghislain