Doublons

18doublons.xlsx (12.05 Ko)

Bonjour,

Voici mon soucis

J'ai dans ma colonne A des numéros qui peuvent se trouver en double et en colonne I des chiffres

Ce que j'aimerais c'est dans un premier temps détecté les doublons, en supprimer un (ou déplacer dans une autre feuille) et additionné les chiffres de la colonnes I

Voir exemple, l'explication est plus claire.

D'avance merci

Bonjour,

Voir l'utilisation d'un tableau croisé dynamique.

Cdlt.

10doublons.xlsx (17.46 Ko)

Bonsoir le fil, bonsoir le forum,

Une proposition VBA (j'ai jamais rien compris au TCD...) avec le code ci-dessous :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim LS As Range 'déclare la variable LS (Lignes à Supprimer)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP1 As Variant 'déclare la variable TMP1 (tableau TeMPoraire 1)
Dim TMP2 As Variant 'déclare la variable TMP2 (tableau TeMPoraire 2)
Dim TD() As Variant 'déclare la variable TD (Tableau des Données)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Integer 'déclare la variable K (incrément)
Dim VT As Integer 'déclare la variable VT (Valeur du Total)
Dim J As Integer 'déclare la variable J (incrément)
Dim L As Integer 'déclare la variable L (incrément)

'*****************************************************************************************
'cette partie permet de créer un tableau de deux colonnes avec dans la colonne 0 tous les
'numéros de commandes et en colonne 1 le nombre de fois que ce numéro de commande apparaît
'*****************************************************************************************
Set O = Sheets("Doublons") 'définit l'onglet O
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC
Set LS = O.Range("A1") 'initialise la plage LS
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TC, 1) 'boucle sur toutes les lignes I du tableau TC (en partant de la seconde)
    D(TC(I, 1)) = D(TC(I, 1)) + 1 'alimente le dictionnaire D
Next I 'prochaine ligne de la boucle
TMP1 = D.keys 'récupère dans le tableau temporaire TMP1 la liste des éléments du dictionnaire D sans doublon
TMP2 = D.items 'récupère dans le tableau temporaire TMP2 le nombre d'occurrence de chaque élément
ReDim Preserve TD(1, UBound(D.keys)) 'redimensionne le tableau des données TD
For I = 0 To UBound(TMP1, 1) 'boucle sur tous les éléments I du tableau temporaire TMP1
    TD(0, I) = TMP1(I) 'récupère l'élément, dans la colonne 0 du tableau TD
    TD(1, I) = TMP2(I) 'récupère le nombre d'occurrences de l'élément, dans la colonne 1 du tableau TD
Next I 'prochain élément de la boucle

'************************************************************************************
'cette partie permet de renvoyer le total des doublons dans la première ligne d'un
'élément doublonné et de stocker dans le tableau TL les numéros de ligne des doublons
'************************************************************************************
For I = 0 To UBound(TD, 2) 'boucle 1 : sur tous les éléments I du tableau TD
    Erase TL 'efface le tableau TL
    K = 0 'initialse la variable K
    VT = 0 'initialise la variable VT
    If TD(1, I) > 1 Then 'condition 1 : si le nombre d'occurrences de l'élément est supérieur à 1
        For J = 2 To UBound(TC, 1) 'boucle 2 : sur toutes les lignes J du tableau TC (en partant de la seconde)
            'condition 2 : si la valeur en ligne J colonne 1 du tableau TC correspond à l'élément I du tableau TD
            If TC(J, 1) = TD(0, I) Then
                VT = VT + TC(J, 9) 'additionne la valeur ligne J colonne 9 du tableau TC
                ReDim Preserve TL(K) 'redimensionne le tableau TL
                TL(K) = J 'récupère le numéro de ligne J du tableau TC
                K = K + 1 'incrémente K
            End If 'fin de la condition 2
        Next J 'prochaine ligne de la boucle 2
        O.Cells(TL(0), 9).Value = VT 'renvoie la valeur VT dans la cellule ligne TL(0) colonne 9

        '****************************************************************************************
        'cette partie permet de créer un plage correspondante aux lignes à supprimer des doublons
        '****************************************************************************************
        For L = 1 To UBound(TL, 1) 'boucle 3 : sur toutes les lignes des doublons du tableau TL (sans compter la première)
            'redéfinit la plage LS
            Set LS = IIf(LS.Cells.Count = 1, Rows(TL(L)), Application.Union(LS, Rows(TL(L))))
        Next L 'prochaine ligne de la boucle 3

    End If 'fin de la condition 1
Next I 'prochain élément du tableau TD
If LS.Address <> "$A$1" Then LS.Delete 'si l'adresse de LS est différente de A1, supprime la plage PL
End Sub

Merci à vous deux.

La macro fonctionne à merveille mais je ne peut me servir du classeur comme modèle Excel, mon système ne prenant en charge que le .xlt ou .xltx et pas le .xltm donc je vais voir comment m'en servir.

Mon fichier Excel est crée automatiquement par le système et mon but est de faire le tri dés que le fichier est crée.

J'ai un soucis avec le fonctionnement du TCD, si je rajoute des lignes ça ne fonctionne pas ?

Bonjour,

Voir fichier modifié.

Utilisation d'un tableau dynamique (Excel2007+).

L'actualisation est manuelle et s'effectue avec la commande 'Actualiser' du menu Outils de tableau croisé dynamique / Options.

Cdlt.

11doublons-v1.xlsx (18.29 Ko)

Super jean-Eric,

Ca fonctionne à merveille

je fais un petit test d'intégration dans mon système pour voir si je que je veut en faire fonctionne bien.

Jean-Eric,

Je t'aurais sous la main, je te paierais l'apéro

Tous fonctionnes comme je le voulais, intégration ok dans mon système que du bonheur

Encore merci à toi et à ThauThème

Re,

Facile, je suis chez toi demain.

A bientôt sur le forum.

Rechercher des sujets similaires à "doublons"