[résolu ] vba optimisation macro

[sarahbernard]

Bonjour à tous

Je suis en train d'écrire une macro dans le cadre de mon travail.
Je rencontre un soucis d'optimisation de ma macro.
En effet dans le fichier joint, je vous ai fait un exemple (sans les données confidentielles). Je dois remplir le tableau de la feuille 2 selon plusieurs critères par rapport à la feuille 1. Sauf que ce dernier fait environ 20000 lignes et que mon tableau sans doublons de la feuille 2 fait environ 5000 lignes.
Ma macro met donc un temps infini pour s'exécuter.

Merci de toute l'aide que vous pourrez m'apporter

Sarah

 

[M12]

Bonjour,

Teste avec ce code

Sub tableau()
Dim t, a As Integer
Dim F1 As Range
Dim F2 As Range
Dim DernLigne1 As Long
Dim DernLigne2 As Long
    DernLigne1 = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
    DernLigne2 = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
    Worksheets(2).EnableCalculation = False
        Set F1 = Sheets("Feuil1").Range("A2:A" & DernLigne1)
        Set F2 = Sheets("Feuil2").Range("A2:A" & DernLigne2)
            For t = 2 To F2.Rows.Count
                For a = 2 To F1.Rows.Count
                    If F1(a, 2).Value = Sheets(3).Cells(3, 1).Value Then
                        If F2(t, 1).Value = F1(a, 1).Value Then
                            F2(t, 3).Value = "1"
                        End If
                    End If
                Next a
            Next t
    Worksheets(2).EnableCalculation = False
End Sub

 

[laetitia90]

bonjour sarah ,M12
manque quelques explications en clair quel feuille fait 20000 lignes ???
pourquoi tu pars du bas ????

ENFIN !!!! dans tout les cas de figure sur des gros fichier il faut manipuler un "tablo" ou tableau
quand je parle de tablo ou tableau
en simple je remplis une plage de cellule que je stocke dans une variable tableau
Les éléments du tableau sont indexés séquentiellement
bien plus rapide dans beaucoup de cas

 

[Paf]

Bonjour à tous,

Si j'ai bien compris, il s'agit de mettre "1" en colonne C de la feuille2, pour tout code client qui possède "AV108" en colonne B de la feuille1.

Si c'est ça, une solution sans double boucles imbriquées est envisageable, mais .... j'ai bien peur que ce ne soit pas si simple car :

Je dois remplir le tableau de la feuille 2 selon plusieurs critères par rapport à la feuille 1

laisse supposer qu'on ne traite pas uniquement "AV108" ?

Des précisions donc .

A+

 

[sarahbernard]

Re

Merci pour votre aide.
Alors effectivement, il y a d'autre code à traiter que AV108.... Et normalement c'est le tableau de la feuille 1 que fait près de 20000.

J'ai essayé de faire procéder de façon différente. Cette après midi , j'ai testé la création de 4 onglets pour récupérer les codes clients qui correspondent à chacun de ces codes et ensuite de pouvoir les re-ventiler dans mon tableau de récap. Mais meme problème.

Pour répondre à Laetitia90, je pense aussi que c'est la solution, mais je ne sais pas manipulé les tableaux en VBA.

En tout cas, merci pour votre aide à toutes et tous

 

[Paf]

Re,

Alors effectivement, il y a d'autre code à traiter que AV108.... Et normalement c'est le tableau de la feuille 1 que fait près de 20000.

Avais bien compris le principe? a priori non ! puisque d'après votre classeur on va chercher ce code (ex : "AV108") en A3 de la feuille 3 ?

et si vous expliquiez ce que vous voulez vraiment ?

s'il y a plusieurs codes accord (?) pour un seul code client (cas du code client 0111350 qui a 5 codes accord), si on renseigne sa colonne C (feuille2) avec 1 (si code accord="AV108") que faut il mettre et où pour les autres codes accord ?
on ne peut avoir qu'une seule information par client en colonne C !

A+

 

[sarahbernard]

Rebonjour à tous

J'étais de repos hier, d'où ma réponse tardive...
Je vais essayer d'être clair dans mes explications.
Sur la feuille 1, j'ai la liste des clients avec doublons car ils peuvent avoir plusieurs codes avantages
Sur la feuille 2, j'ai besoin et j'aimerais la liste des clients sans doublons et mettre un "1" dans la case correspondante à leurs codes avantages. il peut donc y avoir plusieurs 1 par ligne
Sur la feuille 3, j'ai mis mes codes avantages, pour pouvoir les changer en dynamiques et ne pas changer le code à chaque changement de code avantage.

Je vous met le fichier avec les 18 000 lignes en feuille 1 . Je réussis à faire ce que je veux sauf que, je n'ai pas un niveau très avancé donc forcement en faisant des boucles, ma macro balaie x fois ma liste pour extraire les données et c'est extrémement long. J'aimerais donc votre aide pour m'aider à optimiser un code qui me permettrait de réduire ce temps de traitement.

Merci de votre aide

 

[Paf]

re,

un essai à tester

Sub TrouveCode()
Dim Tab1, TabFin, Plage As Range, Cel As Range, x As Long
Dim Dico
Set Dico = CreateObject("Scripting.Dictionary")
With Worksheets("Feuil3")
Set Plage = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Worksheets("Feuil1")
Tab1 = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Worksheets("Feuil2")
.Range(.Cells(1, 3), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column)).ClearContents
TabFin = .Range(.Cells(2, 1), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, Plage.Count + 2))
x = 2
For Each Cel In Plage
  x = x + 1 'N° de colonne
  .Cells(1, x) = Cel
  For i = LBound(Tab1) To UBound(Tab1)
  If Tab1(i, 5) = Cel Then Dico(Tab1(i, 1)) = 1
  Next
  For j = LBound(TabFin) To UBound(TabFin)
  If Dico.exists(TabFin(j, 1)) Then TabFin(j, x) = Dico(TabFin(j, 1))
  Next
  Dico.RemoveAll
Next
  .Cells(2, 1).Resize(UBound(TabFin, 1), UBound(TabFin, 2)) = TabFin
End With
End Sub

A+

 

[Dranreb]

Bonjour
Vos deux listes sont classées sur le client alors je ne comprends pas pourquoi il vous faudrait les balayer entièrement toutes les deux dans deux boucles imbriquées.
En fait je ne comprends même pas pourquoi vous ne refaite pas entièrement la Feuil2 en y mettant les clients rencontrés dans la Feuil1.

 

[Paf]

re et bonjour Dranreb,

Sans vérifier, je pensais qu'il y avait des clients en plus ou en moins dans l'une ou l'autre liste, en fait ce sont strictement les mêmes .

une sorte de 'transpose' définitif par client aurait effectivement suffi.
Edit : en fait il y a 597 codes différents , ce ne serait sans doute pas très lisible

ou bien un filtre élaboré directement sur la feuille1, si on veut trier sur quelques codes.

A+

 

[sarahbernard]

Bonjour

MERCI Paf ! Le code fait exactement ce dont j'ai besoin.....
Merci milles fois pour votre aide. J'ai encore un petit service a demander.
J'aurais aimé avoir (si tu as le temps) des explications sur le code afin de le comprendre.

A très bientot

 

[Paf]

Re,

quelques explications

Sub TrouveCode()
Dim Tab1, TabFin, Plage As Range, Cel As Range, x As Long
Dim Dico
Set Dico = CreateObject("Scripting.Dictionary") ' création d'un dictionnaire
With Worksheets("Feuil3")
Set Plage = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row) 'plage contenant les codes à mettre à jour
End With
With Worksheets("Feuil1")
Tab1 = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row) 'tableau des données feuille1, pour aller plus vite
End With
With Worksheets("Feuil2")
.Range(.Cells(1, 3), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column)).ClearContents ' effacements des données variables feuil2
TabFin = .Range(.Cells(2, 1), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, Plage.Count + 2)) 'tableau feuille2
x = 2
For Each Cel In Plage ' pour chaque valeur de la plage, donc pour chaque code
  x = x + 1 'N° de colonne : 3 pour le 1er code, 4 pour le 2ème ...
.Cells(1, x) = Cel  'écriture du code en t^te de colonne
  For i = LBound(Tab1) To UBound(Tab1) 'pour chaque ligne du tabeau feuil1
  If Tab1(i, 5) = Cel Then Dico(Tab1(i, 1)) = 1 'si la colonne  5 = code on crée un enregistrement dans le dictionnaire
                                                                            ' avec pour clé le code client(colonne 1 du tableau)
  Next
  For j = LBound(TabFin) To UBound(TabFin) ' pour ligne du tableau feuil2
  If Dico.exists(TabFin(j, 1)) Then TabFin(j, x) = Dico(TabFin(j, 1)) 'si dans le dictionnaire il existe une ligne pour
                                                                                                             le  code client(colonne 1 du tableau) on écrit dans la
                                                                                                              colonne x du tableau
  Next
  Dico.RemoveAll  ' on efface tous les enregistrements du dictionnaire
Next
  .Cells(2, 1).Resize(UBound(TabFin, 1), UBound(TabFin, 2)) = TabFin  ' on copie le tableau sur la feuille
End With
End Sub

A+

 

[sarahbernard]

Merci infiniment Paf d'avoir partager tes connaissances !