Gerer les doublons

Bonjours,

j'ai un classeur volumineux et J'aimerais cette fois ,qu'à chaque plage de doublons,avoir un total des lignes ainsi que leurs désignations , après cela , supprimer ces lignes cumulées automatiquement .

et Merci d’avance.

Ci-joint mon fichier:

https://www.cjoint.com/c/HIywsgKbRpa

Bonjour,

Une piste avec un dictionnaire et un tableau à deux dimensions. Pour le test, le résultat est inscrit dans la fenêtre d'exécution (Ctrl+G). Si d'autres totaux à faire, adapter la première dimension du tableau dans la déclaration. Explications dans le code :

Sub Test()

    Dim Dico As Object
    Dim Plage As Range
    Dim Cel As Range
    Dim Cle As Variant
    Dim Tbl(1 To 4, 1 To 1) As Long
    Dim T

    Set Dico = CreateObject("Scripting.Dictionary")
    With ActiveSheet: Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In Plage

        If InStr(Cel.Value, "TOTAL") = 0 Then

            'si pas initialisé, ajoute le tableau dans le dico
            If Dico.Exists(Cel.Value) = False Then Dico(Cel.Value) = Tbl

            'comme il n'est pas possible de modifier directement dans le dico, utilisation d'un tableau intermédiaire
            T = Dico(Cel.Value)
            'totalise les différents champs...
            If IsNumeric(Cel.Offset(, 4).Value) Then T(1, 1) = T(1, 1) + Cel.Offset(, 4).Value
            If IsNumeric(Cel.Offset(, 8).Value) Then T(2, 1) = T(2, 1) + Cel.Offset(, 8).Value
            If IsNumeric(Cel.Offset(, 12).Value) Then T(3, 1) = T(3, 1) + Cel.Offset(, 12).Value
            If IsNumeric(Cel.Offset(, 14).Value) Then T(4, 1) = T(4, 1) + Cel.Offset(, 14).Value
            'puis remet dans le dico
            Dico(Cel.Value) = T

        End If

    Next Cel

    'résultat à adapter dans la feuille Excel, ici, dans la fenêtre d'exécution (Ctrl+G)
    For Each Cle In Dico.Keys

        Debug.Print Dico(Cle)(1, 1); " --- "; Dico(Cle)(2, 1); " --- "; Dico(Cle)(3, 1); " --- "; Dico(Cle)(4, 1)

    Next Cle

End Sub

Bonjour;

connaissant assez peu les codes VBA, j'en réfère à vos capacités car je n'ai pas saisi le code que vous m'avez envoyé du tout vous m'excuseriez, mais merci en tout cas je me débrouillerais autrement.

cordialement

Bonjour,

Le résultat en feuille "Feuil2".

Sur ton classeur exemple, pour faire un test, supprimes les lignes de résultat afin quelles ne perturbent pas.

Le code ci-dessous est à mettre dans un module standard (depuis Excel, maintenir la touche Alt enfoncée puis faire la série de touche F11, I, M) coller le code dans la zone de texte qui vient d'apparaître, mettre le curseur n'importe où dans le code et appuis sur la touche F5 pour lancer la procédure, voir le résultat en feuille 2 :

Sub Test()

    Dim Dico As Object
    Dim Plage As Range
    Dim Cel As Range
    Dim Cle As Variant
    Dim Tbl(1 To 20, 1 To 1)
    Dim T
    Dim I As Long
    Dim J As Integer

    Set Dico = CreateObject("Scripting.Dictionary")

    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    For Each Cel In Plage

        If InStr(Cel.Value, "TOTAL") = 0 Then

            'si pas initialisé, ajoute le tableau dans le dico
            If Dico.Exists(Cel.Value) = False Then Dico(Cel.Value) = Tbl

            'comme il n'est pas possible de modifier directement dans le dico, utilisation d'un tableau intermédiaire
            T = Dico(Cel.Value)

            T(1, 1) = Cel.Offset(, 1).Value 'N° Ordre
            T(2, 1) = Cel.Offset(, 2).Value 'Année
            T(3, 1) = "IR"
            If IsNumeric(Cel.Offset(, 4).Value) Then T(4, 1) = T(4, 1) + Cel.Offset(, 4).Value 'Montant IR
            T(5, 1) = "IB"
            If IsNumeric(Cel.Offset(, 6).Value) Then T(6, 1) = T(6, 1) + Cel.Offset(, 6).Value 'Montant IB
            T(7, 1) = "TP"
            If IsNumeric(Cel.Offset(, 8).Value) Then T(8, 1) = T(8, 1) + Cel.Offset(, 8).Value 'Montant TP
            T(9, 1) = "REV.Loc"
            If IsNumeric(Cel.Offset(, 10).Value) Then T(10, 1) = T(10, 1) + Cel.Offset(, 10).Value 'Montant REV.LOC
            T(11, 1) = "TV"
            If IsNumeric(Cel.Offset(, 12).Value) Then T(12, 1) = T(12, 1) + Cel.Offset(, 12).Value 'Montant TV
            T(13, 1) = "Amende"
            If IsNumeric(Cel.Offset(, 14).Value) Then T(14, 1) = T(14, 1) + Cel.Offset(, 14).Value 'Montant amende
            T(15, 1) = "IFU"
            If IsNumeric(Cel.Offset(, 16).Value) Then T(16, 1) = T(16, 1) + Cel.Offset(, 16).Value 'Montant IFU
            T(17, 1) = "IBM"
            If IsNumeric(Cel.Offset(, 18).Value) Then T(18, 1) = T(18, 1) + Cel.Offset(, 18).Value 'Montant IBM
            T(19, 1) = "TPF"
            If IsNumeric(Cel.Offset(, 20).Value) Then T(20, 1) = T(20, 1) + Cel.Offset(, 20).Value 'Montant TPF

            'puis remet dans le dico
            Dico(Cel.Value) = T

        End If

    Next Cel

    'résultat en feuille "Feuil2" à adapter
    For Each Cle In Dico.Keys

        T = Dico(Cle)
        I = I + 1

        For J = 1 To UBound(T)

            Worksheets("Feuil2").Cells(I, 1) = Cle
            Worksheets("Feuil2").Cells(I, J + 1) = T(J, 1)

        Next J

        J = 0

    Next Cle

End Sub

Bonjour Monsieur,

Ça a marché très bien Je tenais à vous remercier pour l'aide que vous m'avez apportée. votre savoir-faire m'ont été d'un grand secours pour accomplir la fastidieuse tâche qui m'incombait.

Je vous suis très reconnaissant.

Tous mes remerciements,

content de t'avoir aidé