XL 2013 Accélérer boucle de doublons

Akatsucki

XLDnaute Nouveau
Bonjours j’aimerais augmenter la vitesse du regroupement des doublons dans ce fichier qui prends beaucoup de temps, j'ai pensé à utilisé la methode du dictionnaire mais je ne sais pas par ou commencer car il y a plusieurs condition
If True Then 'Suppression des doublons CurrentRow = iStartRow bSautPageDone = False Go = True Do While (CurrentRow < iLastRow And Go) s24hInit = Cells(CurrentRow, sPosteCol).Value sMouleInit = Cells(CurrentRow, SMouleCol).Value sProgInit = Cells(CurrentRow, sProgrammePostCol).Value sCodeTissu = Cells(CurrentRow, sTissuCol - 2).Value sLargeur = Cells(CurrentRow, sLargeurCol).Value sMachine = Cells(CurrentRow, sMachine1Col).Value 'Saut de page pour les Qt a 0 If (Cells(CurrentRow, sProgrammePostCol) = 0 And Not bSautPageDone) Then iSautPageNum = CurrentRow bSautPageDone = True 'SautPage End If 'Mise en forme du premier champ de commentaire si ligne non vide If (sCodeTissu <> "" Or sLargeur <> "" Or sMachine <> "") Then Cells(CurrentRow, sCommConfCol).Value = "'" & Cells(CurrentRow, sRolCol + 1).Value & " " & Cells(CurrentRow, sCommConfCol).Value & " " Else Go = False End If Workrow = CurrentRow + 1 sCodeTissu1 = Cells(Workrow, sTissuCol - 2).Value sLargeur1 = Cells(Workrow, sLargeurCol).Value sMachine1 = Cells(Workrow, sMachine1Col).Value Dim sIsMultiPlis As Boolean sIsMultiPlis = Cells(Workrow, 1).Value <> "" While (sCodeTissu = sCodeTissu1 And sLargeur = sLargeur1 And sMachine = sMachine1 And (sCodeTissu <> "" Or sLargeur <> "" Or sMachine <> "") And Not sIsMultiPlis) 'rolhing + commentaire Cells(CurrentRow, sCommConfCol).Value = Cells(CurrentRow, sCommConfCol).Value & Cells(Workrow, sCommConfCol).Value & " " 'Copy des quantités Range(Cells(Workrow, 23), Cells(Workrow, 34)).Copy Range(Cells(Workrow, 23), Cells(Workrow, 34)).Offset(-1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _ :=False, Transpose:=False Range(Cells(Workrow, 16), Cells(Workrow, 19)).Copy Range(Cells(Workrow, 16), Cells(Workrow, 19)).Offset(-1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _ :=False, Transpose:=False 'Suppression de la ligne Cells(Workrow, 1).EntireRow.Delete Shift:=xlUp 'Mise a jour des valeur pour l'iteration suivante sCodeTissu1 = Cells(Workrow, sTissuCol - 2).Value sLargeur1 = Cells(Workrow, sLargeurCol).Value sMachine1 = Cells(Workrow, sMachine1Col).Value Wend 'Division en nombre de K7 Cells(CurrentRow, 19).Select If Cells(CurrentRow, 7).Value = "KM" Then ActiveCell.Value = ActiveCell.Value / smetrageK7KM Else ActiveCell.Value = ActiveCell.Value / smetrageK7EST End If CurrentRow = CurrentRow + 1 Loop End If


je vous joint mon fichier pour plus de détail
https://cjoint.com/c/KDrmv7yK2hm
 

Akatsucki

XLDnaute Nouveau
Bonjour Akatsucki, bienvenue sur XLD,

Pas de chance pour un 1er post car vous le commencez par une énormité : If True Then.

Car True étant toujours True ce qui suit est toujours exécuté :rolleyes:

A+
Oui je sais mais je n’ai que mis une partie de la macro car il y a énormément de variable et donc pour comprendre le code il faut regarder le fichier en entier

Je ne suis pas le créateur de ce code, mais j’aimerais l’améliorer pour y gagner du temps

cordialement
 

Akatsucki

XLDnaute Nouveau
Bonsoir
puré avec un filtre ou le tri c'est si simple de mettre tout les doublons a la suite
je ne te dirais pas que donner la moitié du code utilisé n'augmentera pas les chances de réponse
si je l'ai dis bon ben a bon entendeur alors ;)

merci de votre réponse mais cela n’est pas aussi simple que vous pensiez, il faut récupérer les données de certaines colonnes et les additionner quand il s’agit du même code, tissu , largeur et machine puis supprimer la ligne ou on a récupérer les données...
Puis enchaîner sur la suite des autre

donc un simple filtre ne suffit pas, je vous invite à regarder mon fichier en entier et voir par vous même que le code et assez conséquent

cordialement
 

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
288 581
Messages
1 893 171
Membres
169 777
dernier inscrit
Bazilecr
Haut Bas