Rassembler données de doublons multi critéres (Expert VBA requis)

Résolu

Akatsucki Messages postés 90 Date d'inscription Statut Membre Dernière intervention -
Akatsucki Messages postés 90 Date d'inscription Statut Membre Dernière intervention - 17 avril 2021 à 22:35

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

Afficher la suite

A voir également:

Rassembler données de doublons multi critéres (Expert VBA requis)
Fuite données maif - Guide
Doublons photos - Guide
Supprimer les données de navigation - Guide
Expert php pinterest - Télécharger - Langages
Trier des données excel - Guide

1 réponse

Réponse 1 / 1

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

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.

Akatsucki Messages postés 90 Date d'inscription Statut Membre Dernière intervention

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

Discussions similaires

Problème d'app Gmail : "Identifiants requis"

Recherche multi exp dans pokémon heart gold

Pokémon SoulSilver multi exp

2eme multi exp?

Identifiant requis

Votre réponse

Discussions similaires