Optimisation d'un code de suppression des doublons
Bonjour,
En réalité, mon code doit faire deux choses :
1) supprimer les doublons (colonne 29 : adressage)
2) Additionner les montants (en valeurs) de la colonne 30 de tous les doublons (pour qu'à la fin on ait la somme des doublons
Mon idée était d'abord de trier selon la valeur de la colonne 29, et ainsi que les doublons soient collés. Il me suffisait ensuite de les supprimer et d'additionner leurs valeurs.
Sub traitement_abo()
nbLigneAbo = Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Rows.Count
Range(Cells(1, 1), Cells(nbLigneAbo, 30)).Sort Key1:=Columns(29), order1:=xlDescending
For i = nbLigneAbo To 3 Step -1
If Cells(i, 29) = Cells(i - 1, 29) Then
Cells(i - 1, 30) = Cells(i, 30) + Cells(i - 1, 30)
Rows(i).Delete
End If
Next i
End SubCette méthode marche, mais elle est très longue.
N'y aurait-il pas un moyen d'optimiser mon code pour qu'il soit plus rapide ?
Bonjour
Même chose qu'ici https://forum.excel-pratique.com/excel/gestion-de-donnees-multiples-suppression-et-addition-t42860.html à part les colonnes
Macro adaptée à ton cas
Sub Rectangleàcoinsarrondis1_Cliquer()
' suppression doublons et calcul
Dim k As Long, Nblg As Long
Dim Mondico As Object
Application.ScreenUpdating = False
Nblg = Range("AC1").End(xlDown).Row
Set Mondico = CreateObject("Scripting.dictionary")
For k = 1 To Nblg
Mondico(Range("AC" & k).Value) = Mondico(Range("AC" & k).Value) + Range("AD" & k)
Next k
Range("AC1:AD" & Nblg).ClearContents
Range("AC1").Resize(Mondico.Count) = Application.Transpose(Mondico.keys)
Range("AD1").Resize(Mondico.Count) = Application.Transpose(Mondico.items)
End SubBonjour,
J'avoue ne pas comprendre grand chose à ton code.
J'ai simplifié dans mon exemple. Pourrais-tu me dire ce que je dois modifier pour prendre en compte les deux contraintes supplémentaires que j'ai ? :
- Je dois garder l'adressage par numéros de colonne
- En réalité, mes montants et mes doublons ne sont pas côte à côte. Le montant se trouve sur la colonne 46, et le doublon sur la colonne 56. Cela importe-t-il ici ?
Merci beaucoup en tout cas ! Tu m'as déjà beaucoup aidé !
Bonjour
J'avoue ne pas comprendre grand chose à ce que tu veux : C'est pour un exercice ?
Essayes
Sub Rectangleàcoinsarrondis1_Cliquer()
' suppression doublons et calcul
Dim K As Long, Nblg As Long
Dim Mondico As Object
' Masque le raffraichissement écran
Application.ScreenUpdating = False
' Nombre de ligne à traiter
Nblg = Cells(1, 56).End(xlDown).Row
' Création d'un objet qui n'accepte que les données uniques
Set Mondico = CreateObject("Scripting.dictionary")
' Pour toutes les lignes
For K = 1 To Nblg
Mondico(Cells(K, 56).Value) = Mondico(Cells(K, 56).Value) + Cells(K, 46)
Next K
Columns("A:B").ClearContents
Cells(1, 1).Resize(Mondico.Count) = Application.Transpose(Mondico.keys) ' Copie des noms sans doublon en colonne A
Cells(1, 2).Resize(Mondico.Count) = Application.Transpose(Mondico.items) ' Copie du total en colonne B
End SubBonjour Banzaï64,
Je t'assure que ce n'est pas un exercice, mais dans la mesure où ce code s'insère dans un code beaucoup plus long, je préfère pouvoir modifier la référence à mes colonnes rapidement en introduisant pour chacune des colonnes dont je fais référence une variable au tout début (si d'un seul coup, j'ai besoin de faire que la colonne 56 qui représente les montants deviennent pour tout le code la 55, il me suffit de ne changer le code qu'à un seul endroit.
Quant à ton code, je le trouve vraiment très bien (incroyablement plus rapide que le mien), mais j'aimerais quant à moi pouvoir garder toutes les lignes de mon fichier où il n'y a pas de doublon sur la colonne 56 (pas seulement conserver les colonnes 46 et 56).
N'y aurait-il pas un moyen de modifier légèrement ce code pour le permettre ?
Edit :
Je me suis renseigné depuis, et j'ai découvert ce qu'était des dictionnaires dans vba. Malgré tout, je ne suis pas certain de maîtriser toutes leurs subtilités. Pour récupérer toutes mes colonnes (donc garder mes lignes sans doublon),, dois-je créer plusieurs Items qui viendront chacun récupérer une colonne en fonction de la même clef ?
Je suis vraiment perdu (et ça m'aiderait beaucoup pourtant)
Pouvez-vous m'aider s'il-vous-plait ?
Bonsoir
Je ne sais pas si ce post est toujours d'actualité
Dans l'affirmative
Tu joins un fichier dans lequel tu notes ce que tu as et manuellement tu inscris le résultat escompté