Rassembler données de doublons multi critéres (Expert VBA requis) [Résolu]

Signaler
Messages postés
82
Date d'inscription
jeudi 1 octobre 2020
Statut
Membre
Dernière intervention
4 mai 2021
-
Messages postés
82
Date d'inscription
jeudi 1 octobre 2020
Statut
Membre
Dernière intervention
4 mai 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

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
                                'POINT A AMELIORER
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

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


'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


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

1 réponse

Messages postés
15610
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 mai 2021
855
bonjour,
l'indentation défectueuse de ton code le rend peu lisible.
j'y vois deux boucles imbriquées.
est-ce cela qui le rend lent? as-tu pu identifier où le code perdait du temps?
peux-tu donner des informations factuelles à propos du temps que cela prend?

il serait sans doute utile que tu décrives ce que tu veux obtenir et comment u le fais, plutôt que nous laisser le deviner en analysant ton code.
entre humains, il est plus efficace d'utiliser une langue telle que le français.
de plus, ton code est peut-être incorrect ou inefficace.

au hasard:
il est parfois utile d'utiliser les tableaux pour accélérer l'accs aux données.
il est parfois utile de trier les données pour accélérer la détection de doublons.
Messages postés
82
Date d'inscription
jeudi 1 octobre 2020
Statut
Membre
Dernière intervention
4 mai 2021

Bonsoir,
Merci de ta réponse, je sais que je n’est pas donné énormément d’informations sur ce que je désire réellement... je m’explique :

Le tableau est trié dès lors que la macro ci dessus commence, elle dois récupérer les donnée de certaine cellules et les additionner a la colonne supérieure pour garder une et une seule ligne sur les doublons possible
Les doublons sont cherchés d’après plusieurs critères ( code,tissu,largeur et machine)

En gros si à la ligne 6 et à la ligne 7 ces conditions sont respectées, on additionne les cellules désiré puis on supprime la ligne qu’on a récupèré... puis on continue la boucle pour voir si la ligne suivante a les mêmes conditions pour encore additionner et ainsi de suite jusqu’à regrouper toutes les cellules ensemble

Je sais pas si je suis assez clair, à vous de me dire

La macro met environ 2min à ce réaliser mais ceci n’est qu’une partie de l’ensemble des étapes à faire (encore 5 fois la même macro sur d’autre produit qui rallonge la macro à 10min environ)

Pour infos ce n’est pas une macro de moi, donc j’aimerais gagner du temps car c’est à cet endroit que ça prend le plus de temps (entre 60 et 80secondes)

Cordialement