[VBA] Amélioration code (formule matricielle) - Macro lente/longue

Bonjour tout le monde,

Je viens vers vous avec une demande particulière en effet j'ai réussi à trouver comment faire mon code VBA en formule matricielle avec plus de 255 caractères mais maintenant je suis confronté à un problème de temps d'exécution excessivement long (env 2,5mn)

J'ai essayé de chercher comment simplifier mon code mais je n'ai rien trouvé (peut être que c'est tout simplement impossible de la faire aller plus vite ?)

Voici mon code :

Sub FormuleAIntegrer()
Application.ScreenUpdating = False
With Sheets("Modele BOIS")
    .[A2:A500].Name = "CA"
    .[B2:B500].Name = "CB"
    .[C2:C500].Name = "CC"
    .[D2:D500].Name = "CD"
    .[E2:E500].Name = "CE"
    .[A2].Name = "MoA"
End With
With Sheets("Nom descriptif BOIS")
    .[F2:H500].ClearContents
    .[B2].FormulaArray = "=IFERROR(INDEX(CA,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(B$2:B2))),"""")"
    .[B2].Copy .[B3:B500]
    .[C2].FormulaArray = "=IFERROR(INDEX(CB,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(C$2:C2))),"""")"
    .[C2].Copy .[C3:C500]
    .[D2].FormulaArray = "=IFERROR(INDEX(CC,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(D$2:D2))),"""")"
    .[D2].Copy .[D3:D500]
    .[E2].FormulaArray = "=IFERROR(INDEX(CD,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(E$2:E2))),"""")"
    .[E2].Copy .[E3:E500]
    .[A2].Formula = "=IF(B2<>"""",Generalites!$B$2,"""")"
    .[A2].Copy .[A3:A500]
End With
Application.ScreenUpdating = True
End Sub

Je vous remercie d'avance et vous souhaite une bonne journée !

Cordialement,

bonjour,

qu'essaies-tu de faire ?

Hello h2so4,

J'aimerais réussir à faire en sorte que le code s'exécute plus rapidement car actuellement celle-ci prend plus de 2mn à tourner ...

Mais je ne sais pas si c'est possible.

J'ai voulu essayer en remplaçant les :

.[B2].FormulaArray = "=IFERROR(INDEX(CA,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(B$2:B2))),"""")"
    .[B2].Copy .[B3:B500]
    .[C2].FormulaArray = "=IFERROR(INDEX(CB,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(C$2:C2))),"""")"
    .[C2].Copy .[C3:C500]
    .[D2].FormulaArray = "=IFERROR(INDEX(CC,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(D$2:D2))),"""")"
    .[D2].Copy .[D3:D500]
    .[E2].FormulaArray = "=IFERROR(INDEX(CD,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(E$2:E2))),"""")"
    .[E2].Copy .[E3:E500]
    .[A2].Formula = "=IF(B2<>"""",Generalites!$B$2,"""")"
    .[A2].Copy .[A3:A500]

Avec un code type :

For i = 2 To 500
Cells(i, 2).FormulaArray "=IFERROR(INDEX(CA,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(B$2:B2))),"""")"
Cells(i, 3) = "=IFERROR(INDEX(CB,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(C$2:C2))),"""")"
Cells(i, 4) = "=IFERROR(INDEX(CC,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(D$2:D2))),"""")"
Cells(i, 5) = "=IFERROR(INDEX(CD,SMALL(IF(FREQUENCY(IF(CC<>"""",MATCH(CA&"" ""&CB&"" ""&CD&"" ""&CE,CA&"" ""&CB&"" ""&CD&"" ""&CE,0)),ROW(CA)-ROW(MoA)+1),ROW(CA)-ROW(MoA)+1),ROWS(E$2:E2))),"""")"
    .[A2].Formula = "=IF(B2<>"""",Generalites!$B$2,"""")"
    .[A2].Copy .[A3:A500]
Next i

Mais le problème c'est que le code tourne en boucle et du coup je suis obligé de forcer la fermeture du fichier ...

J'avoue que je ne sais pas si je peux le rendre plus rapide à exécuter mais je préfère demander au cas où vous auriez une idée :)

Est-ce que je devrais utiliser du Array et du Ubound

Je ne maîtrise pas assez excel et surtout le VBA donc c'est pour cela que je me tourne vers vous. Il te faut peut être le fichier pour voir comment ça fonctionne j'imagine ?

Merci à toi

rebonjour,

Est-ce que je devrais utiliser du Array et du Ubound

Je ne maîtrise pas assez excel et surtout le VBA donc c'est pour cela que je me tourne vers vous. Il te faut peut être le fichier pour voir comment ça fonctionne j'imagine ?

pour éventuellement faire une proposition, j'aurais voulu comprendre ce que tu essaies de faire avec tes formules. Car il est difficile de se faire une idée de ce qui se passe sans fichier. donc un exemple avec la situation de départ et le résultat que tu veux obtenir (en expliquant éventuellement les règles pour passer de l'un à l'autre), serait bienvenu.

Bonjour h2so4,

Oui je me doute que ce n'est pas simple

J'aurais du joindre un fichier dès le début ;)

En fait j'ai un très gros fichier avec beaucoup d'onglets (j'ai laissé que les deux utiles pour le vba ici).

C'est un fichier envoyé à des fournisseurs qui le complètent et ensuite de mon côté je fais l'onglet "Nom descriptif BOIS" mais comme il y a beaucoup de fournisseurs et de lignes je préfère passer par du VBA

Mon code VBA doit faire la formule matricielle (qui est très longue) et l'étendre sur au moins le nombre de lignes présentes sur l'onglet "Modele BOIS" (c'est pour ça que j'ai décidé de mettre 500 car il est pour le moment impossible qu'un four fasse plus que ce nombre de lignes).

Je ne sais pas si je suis plus clair

N'hésites pas au besoin !

(J'ai supprimé tous mes modules VBA et mes onglets donc j'ai vraiment laissé que la demande, ce qui peut faire penser que c'est léger comme fichier mais c'est pas le cas et du coup ici le VBA prendra peut être que quelques secondes alors que de mon côté on est au moins à 2mn)

Cordialement,

bonjour,

Fournir le mot de passe pour VBA ou un fichier déprotégé...

A+

Mince désolé c'est mon fichier originel le mot de passe c'est Mellon (avec le M majuscule)

Encore désolé !

Bonjour,

je crois que j'ai mal posé ma question, pour éviter de devoir faire du reverse engineering, j'aurais voulu savoir ce que tu essaies d'obtenir comme résultat ?

j'attends une réponse du style, j'ai une liste de départ et je veux obtenir cela à l'arrivée sur base de tel ou tel critère. Peut-être que la formule matricielle n'est pas la meilleure solution, d'où ma demande d'explication sur le besoin initial.

Hello,

Alors en gros sur l'onglet "Nom descriptif BOIS" les colonnes de A à E viennent rechercher les valeurs qui sont sur l'onglet "Modele BOIS" mais petite subtilité je ne veux obtenir qu'une seule ligne contrairement à l'onglet "Modele BOIS" qui peut en avoir plusieurs.

Je pense que tu peux le voir sur le fichier joint celui-ci tu as deux lignes pour un même "produit" :

Car il a des bornes de profondeur différentes, mais sur mon onglet "Nom descriptif BOIS" je n'ai besoin que d'une ligne car c'est le même produit et je n'ai pas besoin d'avoir cette notion de profondeur (je sais pas si c'est très clair).

Il faut bien prendre en compte que le but c'est surtout que si l'une des valeurs dans les colonnes de A à E est différente alors j'aurais une autre ligne sur l'onglet "Nom descriptif BOIS"

Ex :

Ici j'ai bien deux produits différents pourtant seul la teinte change.

Voilà j'espère avoir été un peu plus clair dans mes explications, de mon côté je n'avais trouvé que l'utilisation de formule matricielle pour répondre à ce besoin.

Je ne suis pas très tableau et TCD je préfère éviter ça au maximum.

Merci à toi/vous

re-bonjour,

SI j'ai bien compris, tu cherches à supprimer les doublons sur base des 5 premières colonnes.

Si tu acceptes une macro, voici une solution possible

Sub aspeedup()
    Set ws3 = Sheets("modele bois")
    Set ws1 = Sheets("nom descriptif bois")
    ws3.Copy before:=Sheets(1)
    Set ws2 = ActiveSheet
    dl = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    ws2.Range("$A$1:$L$" & dl).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
    dl = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    ws2.Range("A2").Resize(dl - 1, 5).Copy ws1.Range("B2")
    Application.DisplayAlerts = False
    ws2.Delete
    Application.DisplayAlerts = True
End Sub

Re,

Je ne suis pas sûr de bien comprendre ta macro

En fait :

l'onglet Modele BOIS correspond à une donnée complétée par le fournisseur (je n'y touche pas)

l'onglet Nom descriptif BOIS est complété par moi-même, je viens reprendre les données de l'onglet Modele BOIS (enfin je ne prends que la colonne A / B / D / E) en faisant en sorte de ne conserver qu'une version si le produit est présent plusieurs fois.

Ex :

Onglet Modele BOIS

Onglet Nom descriptif BOIS

Lorsque je test ta macro j'ai un message :

"Le nom "Epaisseurs2" existe déjà. Cliquez sur oui pour utiliser cette version du nom, ou cliquez sur Non pour renommer la version de "Epaisseurs2" que vous déplacez ou copiez

bonjour,

je crois que je me suis mélangé les pinceaux.

regarde si ceci te convient

Hello h2so4,

Alors effectivement ton code fait le taff par contre j'avoue ne pas le comprendre du tout

Sub aspeedup()
    Application.DisplayAlerts = False
    Set ws1 = Sheets("modele bois")
    Set ws3 = Sheets("nom descriptif bois")
    Set ws2 = Sheets.Add 'Création d'un autre onglet ? Pourquoi ?
    dl = ws1.Cells(Rows.Count, 1).End(xlUp).Row 'Ici tu vas chercher la dernière ligne pour l'onglet modele bois ?
    ws2.Range("A1").Resize(dl, 12).Value = ws1.Range("A1").Resize(dl, 12).Value 'Ici tu prends de la colonnes "A1" jusque la dernière ligne et la colonne 12 ? Tout ça sur le nouvel onglet (qui n'existe pas de base sur mon fichier) ?
    ws2.Range("$A$1:$L$" & dl).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes 'Ici tu supprimes tous les doublons par rapport aux arguments de la colonne 1,2,3,4,5 c'est ça ?
    ws2.Columns(3).Delete shift:=xlToLeft 'Tu supprimes la colonne 3 (la forme qui ne me sert pas) ?
    dl = ws2.Cells(Rows.Count, 1).End(xlUp).Row 
    ws2.Range("A2").Resize(dl - 1, 4).Copy ws3.Range("B2") 'Tu copies colle les données de l'onglet temporaire vers mon onglet "Nom descriptif BOIS" ? J'essaie de comprendre le Resize(dl - 1, 4) tu ne prends pas l'entête j'imagines c'est ça ?
    ws3.Range("B2").Resize(dl - 1, 4).Borders.Weight = xlThin 'Mise en forme ?
    ws2.Delete 'Suppression de l'onglet temporaire
    Application.DisplayAlerts = True 'A quoi sert cette alerte ?
End Sub

Je me suis permis dans ton code de mettre des commentaires pour voir si je comprends et si tu peux m'éclairer un peu

Petite question à part : Si dans mon onglet "Modele Bois" j'ai des liste fermées rattachées à des formules avec un nom via ton copier/coller du coup je fais des copies des formules (Noms) ai-je tord ? Cela ne pose t'il pas un problème potentiel dans l'exploitation du fichier ?

Merci d'avance à toi !

bonjour,

ta compréhension des instructions du code est correcte.

'Création d'un autre onglet ? Pourquoi ?

l'instruction removeduplicates se fait au niveau d'une feuille et en modifie le contenu. pour ne pas modifier la feuille de base, la macro prend d'abord une copie des données dans une feuille de travail puis supprime les doublons.

J'essaie de comprendre le Resize(dl - 1, 4)

l'instruction resize permet de définir une plage à partir d'une cellule de référence. donc ici on prend un nombre de lignes (=le numéro de la dernière utilisée -1), sur 12 colonnes) à partir de la cellule A2.

'Mise en forme ?

oui, on trace un trait fin autour de chaque cellule copiée

Application.DisplayAlerts = True 'A quoi sert cette alerte ?

lorsque l'on essaie de supprimer une feuille, on reçoit normalement un message d'alerte, demandant de confirmer la suppression de la feuille.

comme la logique de la macro ne nécessite pas que l'on confirme la suppression de la feuille de travail lorsqu'on en n'a plus besoin, au debut de la macro, il y a l'instruction de ne pas afficher les alertes. application.displayalerts=false

en fin de macro, on re-active l'affichage des alertes. application.displayalerts=true

Petite question à part :

la copie se fait en valeur, on copie le résultat des valeurs calculées par formules. Donc cela ne devrait pas poser de problèmes, mais à confirmer par tes tests.

Ok super ! Du coup effectivement ça va beaucoup plus vite que ma formule matricielle qui doit être faite puis extended sur toutes les colonnes

ça va je commence petit à petit à me familiariser avec le VBA

Merci en tout cas pour le code je vais regarder si cela fait des doublons dans le gestionnaire de nom pour mes formules et si problème je reviendrais vers toi (si ça te dérange pas )

En tout cas top le truc c'est limite mieux qu'une formule matricielle en soit

Bonjour tout le monde !

Bon après des tests ça fonctionne vraiment niquel ! Merci à toi !!