XL 2013 Accélérer boucle de doublons

Akatsucki · 17 Avril 2021

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

job75 · 17 Avril 2021

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é

A+

Akatsucki · 17 Avril 2021

job75 à dit:
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é

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

patricktoulon · 17 Avril 2021

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

Akatsucki · 17 Avril 2021

patricktoulon à dit:
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

XL 2013 Accélérer boucle de doublons

Akatsucki

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Akatsucki

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Akatsucki

XLDnaute Nouveau

Discussions similaires