Doublons intelligents, amélioration de macro

Bonjour à tous,

Cela fait un moment que ce forum me sert de bible et j'ai commencé à développer en VBA depuis peu pour améliorer mes outils de travail.

Je viens vers vous pour requérir votre aide afin d'améliorer une fonction que j'ai développé.

Contexte :

Je suis en charge de la gestion de multiples données concernant la formation des collaborateurs de mon entreprise.

Afin de gérer cela, un outil me permet de sortir un extract de la totalité des formations qui ont été attribuées.

Ces formations concernent des sujets extremement variés et peuvent prendre 3 valeurs de validation :

"In progress"(inscrit mais non réalisé), "Succesfull"(réalisé) et "unsuccesfull"(tenté mais fail).

Problème : un utilisateur, appelons le Roger, peut avoir été inscrit à la même formation plusieurs fois, et ainsi avoir 2 voir 3 lignes concernant la même formation. Ainsi Roger peut avoir la formation A avec une ligne validée et l'autre non.

J'ai donc créer une macro qui me permet de faire un comparatif des doublons et de procéder de la façon suivante :

Si roger à validé la A sur la 1ère ligne et ne l'a pas validé sur la 2eme, il garde la valeur "Succesfull" et l'autre ligne est supprimée.

Si roger à validée la A sur la 2eme ligne et ne l'a pas validé sur la 1ère, il garde la valeur "Succesfull" et l'autre ligne est supprimée.

Si il a 2 lignes "in progress", l'une des 2 est effacée

etc etc.

Bref :

Le but de se post est de savoir si il y'a une possibilité (je n'en doute pas) d'améliorer cette macro pour en réduire le temps de traitement. En effet il faut environ une heure afin que la macro finisse de tourner car ce tableau représente environ 11 000 entrées.

J'ai déjà modifié mes boucles for pour en faire des While plus propre et me permettant de décrémenter ma dernière ligne à chaque deleterow.

J'ai essayé de faire un fichier dont le code est le plus propre possible afin que vous ayez une bonne idée de la façon dont cela fonctionne.

Voilà donc si jamais quelqu'un passe par là et a une astuce ou un début de réponse pour... accélérer cette macro, je suis tout ouie.

Bonne semaine,

Cordialement,

Amaury

Edit :

J'ai l'impression que je n'ai pas enregistré sous le bon format car je ne vois pas mon code dans le fichier joint.

Donc le voici :

Sub DoublonIntelligentV2()
If MsgBox("Continuer ?", 36, "Confirmation") = vbYes Then
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim derniereLigne As Long

derniereLigne = Worksheets("Extract").Range("A" & Rows.Count).End(xlUp).Row
i = 2
'For i = 1 To derniereLigne
While i < derniereLigne
    j = i + 1
    While j < derniereLigne
            If Worksheets("Extract").Cells(i, 1).Value <> "" And Worksheets("Extract").Cells(j, 1).Value <> "" Then
                If Worksheets("Extract").Cells(i, 1).Value = Worksheets("Extract").Cells(j, 1).Value And Worksheets("Extract").Cells(i, 8).Value = Worksheets("Extract").Cells(j, 8).Value Then
                    If Worksheets("Extract").Cells(i, 12).Value = "Successfull" And Worksheets("Extract").Cells(j, 12).Value <> "Successfull" Then
                        Worksheets("Extract").Cells(j, 12).EntireRow.Delete
                        derniereLigne = derniereLigne - 1
                    Else
                        If Worksheets("Extract").Cells(j, 12).Value = "Successfull" And Worksheets("Extract").Cells(i, 12).Value <> "Successfull" Then
                            Worksheets("Extract").Cells(i, 12).EntireRow.Delete
                            derniereLigne = derniereLigne - 1
                        Else
                        If Worksheets("Extract").Cells(j, 12).Value = Worksheets("Extract").Cells(i, 12).Value Then
                                Worksheets("Extract").Cells(j, 12).EntireRow.Delete
                                derniereLigne = derniereLigne - 1
                        End If
                End If
            End If
          End If
           End If
        j = j + 1
        Wend
        i = i + 1
        Wend
End If
End Sub

Bonjour,

si tu enregistres en .xlsx ça supprime les macros...

1ère chose à faire : mettre application.screenupdating=false en début de macro, et s'il y a beaucoup de formules lourdes mettre en calcul manuel et rétablir à la fin.

Si ça ne suffit pas il faut travailler en mémoire, un peu plus complexe.

eric

Bon bah déjà je saurai ça pour la prochaine fois .

Pour le screenupdate j'avais déjà trouvé cette astuce sur le forum ça m'a fait gagner un peu mais c'est minime à priori.

Merci de ta réponse.

J'ai été au plus simple dans un 1er temps en conservant le plus gros ta structure.

La lecture se fait en mémoire. Si ça ne suffit pas il faudra revoir la partie .rows().delete qui prend également du temps.

eric

Merci beaucoup de ta réponse Eric,

Je vais tester ça demain et je te tiendrai au courant.

Pardon mais comme je suis novice, je me posais la question de ce qui faisait dans le code que "La lecture se fait en mémoire" et ce que cela signifie. Est-ce le fait de renseigner les datas dans une variable?

Concernant le Rows.delete, peut-être serait-il plus rapide de "marquer" les lignes concernées et de les supprimer ensuite en masse à la fin de la macro plutôt que une par une? Je vais réfléchir à d'autres façons de faire.

Encore merci pour cette réponse rapide.

Cordialement,

Amaury

Est-ce le fait de renseigner les datas dans une variable?

Oui, les lecture/écritures sur feuille sont très coûteuses.

En mettant dans une variable tableau la lecture ne se fait qu'une fois au lieu de plusieurs milliers de fois.

eric

Merci infiniment la requête est passée à 2 minutes grâce à ta méthode ! Génial j'en apprend tous les jours.

Bonne semaine et encore merci .

Re !

En fait il y'a un souci, beaucoup trop de lignes sont éffacées, et chaque fois que je relance la macro, de plus en plus sont effacé alors qu'elles auraient dû l'être à la première utilisation si tout fonctionnait bien.

J'ai donc essayé de débug, mais la bizarerie fait que au niveau du :

If datas(i, 1) = datas(j, 1) And datas(i, 8) = datas(j, 8) Then

il rentre dans la boucle alors que ça ne correspond pas...

Par exemple là il me confond "CHEVAAL1" et "CHASSAL1" qui sont des ID de 2 personnes différentes. Ensuite il va jusque supprimer la ligne...

Sauriez-vous d'où cela peut provenir?

Dites moi si je me trompe :

... je tente :

Si on rentre les valeurs du tableau dans une variable, alors les numéros de colonnes et lignes j et i sont des valeurs propres au tableau DANS la variable.

Cependant lorsque la macro décide de supprimer, elle supprime les lignes du tableau réel.

==>Ainsi si dans la variable tableau, on a bien Chevaal1 à la 105eme ligne, cela peux ne pas du tout correspondre au tableau Réel car des lignes ont été supprimées dans celui-ci et non dans la variable?

Dites moi si cela n'est pas clair.

En gros la solution serait de redéfinir la variable chaque fois mais cela reprendrai autant de temps que le code de base non?

Bonjour,

Ca devait le faire avant non ? Je n'ai rien changé à ta structure et ton algorithme.

Le seul changement que j'ai fait c'est mettre

If Worksheets("Extract").Cells(i, 1).Value <> "" And Worksheets("Extract").Cells(j, 1).Value <> "" Then

dans 2 if séparés pour diminuer le nombre de boucles.

Contrôle si ta logique est bonne, et si tu n'y arrives pas fourni un fichier (réduit) où tu constates le problème en précisant ce qui ne va pas.

eric

J'ai jeté un oeil.

Quand tu supprimes une ligne et que tu es dans une boucle il faut la faire à l'envers, ou bien ne pas incrémenter la boucle.

Si tu es en ligne 10 et que tu la supprimes la 11 passe en 10. Si ton pointeur passe à 11 la nouvelle ligne 10 n'est pas testée (et si tu boucles à l'envers tu n'as pas ce pb).

Ou bien, si tu veux gagner encore du temps, met un x dans une colonne supplémentaire. A la fin tu filtres dessus et supprimes les lignes visibles.

eric