Discussion :

[arkhang]

Bonjour,

Je reprend un post que j'avais créé ce matin, mais où je me suis apparemment mal exprimé.
Mon problème est le suivant, j'ai un tableau de 4 colonnes et par moment il m'arrive de me retrouver avec des doublons, exemple:

---A--- - ----B--- - ---C--- - ---D---
2012334 - toto - tata - -413,76
2012374 - dupond - dupont - -1283,7
2012374 - dupond - dupont - -1011,4
2012374 - dupond - dupont - -155,6

J'aimerai obtenir:

2012334 - toto - tata - -413,76
2012374 - dupond - dupont - -2450,7

Le tout sur la même feuille de départ.

Je comprends le mécanisme, boucler jusqu'à tomber sur un doublon, un fois trouver garder la valeur en D et l'additionner Tant Que j'ai des doublons.
Mais entre ma compréhension ... Et mon niveau de coda en VBA, eh ben il y a un bon petit gouffre lol !

Je ne pense pas que cela soit vraiment difficile à mettre en place, c'est pourquoi je me permets de soliciter votre aide.

Merci d'avance, cordialement, arkhang.

[Daniel.C]

Bonjour,

Mets en tête de module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Base 1

et exécute :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub test()
    'Option Base 1
    Dim Dico As Object, Tabl As Variant, TablA(), Ctr As Long
    Dim Txt As String, Result() As String
    Set Dico = CreateObject("Scripting.Dictionary")
    Tabl = Range([A1], Cells(Rows.Count, 1).End(xlUp)).Resize(, 4)
    TablA = Range([A1], Cells(Rows.Count, 1).End(xlUp))
    For i = 1 To UBound(TablA)
        Txt = Tabl(i, 1) & "***" & Tabl(i, 2) & "***" & Tabl(i, 3)
        If Not Dico.exists(Txt) Then
            Dico.Add Txt, Txt
            Ctr = Ctr + 1
            ReDim Preserve Result(4, Ctr)
            If Result(4, Ctr) = "" Then Result(4, Ctr) = 0
            Result(1, Ctr) = Tabl(i, 1)
            Result(2, Ctr) = Tabl(i, 2)
            Result(3, Ctr) = Tabl(i, 3)
            Result(4, Ctr) = Result(4, Ctr) + Tabl(i, 4)
        Else
            Var = Application.Match(Txt, Dico.items, 0)
            Result(4, Var) = Result(4, Var) + Tabl(i, 4)
        End If
    Next i
    [A6].Resize(UBound(Result, 2), 4) = Application.Transpose(Result)
End Sub

[arkhang]

Bonjour Daniel,

Tout d'abord, merci de ta rapide réponse.

J'ai essayé ton code, mais il ne semble pas fonctionner correctement, ça me rajoute des lignes, plutôt que de m'en enlever.
Je joins un extrait de mon fichier, qui pourra, je l'espère, t'aider à "m'aider?" lol

Merci d'avance !


cordialement, arkhang.

[Toine-45]

Bonjour
Voici une macro que j'avais fait pour un besoin similaire
Il suffit de mettre ou enlever les ' selon les besoins

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub supprimeDoublons()
'Pour les inventaires
'la macro qui suit permet de supprimer les doublon de la colonne A, d'aditionner les quantitées et les montants
'et de supprimer les cellules vides des colonne A à L (ou les lignes entières)
 
' les références à comparer doivent se suivre.
' Commencer par trier par la colonne dont vous voulez expurger les doublons (code article)
'puis vérifiez que les colones G à M peuvent s'additionner (chiffres).
'libérer les formules correspondantes aux colones désirées, ou vérouiller celles inutiles grâce à l'apostrophe '.
 
  'Recherche de la dernière ligne de la colonne A
  derli = Columns(1).Find("*", , , , , xlPrevious).Row
  ' boucle qui commence à la fin à cause des suppression de cellules
  For i = derli To 2 Step -1
    'Si la valeur de la cellule au dessus est égale à la valeur de la cellule (colonne A) alors
    If Cells(i, 1) = Cells(i - 1, 1) Then
 
    'on additionne les deux montants dans la cellule "A au-dessus"
    'Cells(i - 1, 1) = Cells(i - 1, 1) + Cells(i, 1)
 
    'on additionne les deux montants dans la cellule "B au-dessus"
    'Cells(i - 1, 2) = Cells(i - 1, 2) + Cells(i, 2)
 
    'on additionne les deux montants dans la cellule "C au-dessus"
    'Cells(i - 1, 3) = Cells(i - 1, 3) + Cells(i, 3)
 
    'on additionne les deux montants dans la cellule "D au-dessus"
    'Cells(i - 1, 4) = Cells(i - 1, 4) + Cells(i, 4)
 
    'on additionne les deux montants dans la cellule "E au-dessus"
    'Cells(i - 1, 5) = Cells(i - 1, 5) + Cells(i, 5)
 
    'on additionne les deux montants dans la cellule "F au-dessus"
    'Cells(i - 1, 6) = Cells(i - 1, 6) + Cells(i, 6)
 
      'on additionne les deux montants dans la cellule "G au-dessus"
      'Cells(i - 1, 7) = Cells(i - 1, 7) + Cells(i, 7)
 
      'on additionne les deux montants dans la cellule "H au-dessus"
      Cells(i - 1, 8) = Cells(i - 1, 8) + Cells(i, 8)
 
      'on additionne les deux montants dans la cellule "I au-dessus"
      Cells(i - 1, 9) = Cells(i - 1, 9) + Cells(i, 9)
 
      'on additionne les deux montants dans la cellule "J au-dessus"
      Cells(i - 1, 10) = Cells(i - 1, 10) + Cells(i, 10)
 
      'on additionne les deux montants dans la cellule "K au-dessus"
      Cells(i - 1, 11) = Cells(i - 1, 11) + Cells(i, 11)
 
      'on additionne les deux montants dans la cellule "L au-dessus"
      Cells(i - 1, 12) = Cells(i - 1, 12) + Cells(i, 12)
 
      'on additionne les deux montants dans la cellule "M au-dessus"
      Cells(i - 1, 13) = Cells(i - 1, 13) + Cells(i, 13)
 
      'on additionne les deux montants dans la cellule "N au-dessus"
      'Cells(i - 1, 14) = Cells(i - 1, 14) + Cells(i, 14)
 
      'on additionne les deux montants dans la cellule "O au-dessus"
      'Cells(i - 1, 15) = Cells(i - 1, 15) + Cells(i, 15)
 
      'on additionne les deux montants dans la cellule "P au-dessus"
      'Cells(i - 1, 16) = Cells(i - 1, 16) + Cells(i, 16)
 
      'on additionne les deux montants dans la cellule "Q au-dessus"
      'Cells(i - 1, 17) = Cells(i - 1, 17) + Cells(i, 17)
 
      'on additionne les deux montants dans la cellule "R au-dessus"
      'Cells(i - 1, 18) = Cells(i - 1, 18) + Cells(i, 18)
 
      'on supprime les cellules A à R
        'Range(Cells(I, 1), Cells(I, 18)).Delete Shift:=xlUp
 
           'on supprime les lignes en doublon
                Range(Cells(i, 1), Cells(i, 14)).EntireRow.Delete
    End If
  Next
End Sub

Cordialement

[Marc-L]

Re !

Comme sur la discussion précédente, s'il y a beaucoup de lignes à gérer, la solution la plus simple et rapide
est donc d'utiliser un dictionnaire (comme Daniel) avec la clef sur le matricule et l'Item représentant un indice pointant
sur une variable tableau stockant les noms, prénoms et total cumulé.

Mais comme dans la discussion précédente aucun code publié …

[arkhang]

Re !
Comme la discussion précédente, ton commentaire ne m'apporte rien Marc, si je viens sur ce forum, c'est que j'ai besoin d'aide, et non pas pour entendre ce genre de remarque. Si tu ne veux pas m'orienter, ou m'aider, ne commente pas comme tu le faire s.t.p, ça te fait perdre du temps, et à moi aussi.

@Daniel, je vais essayer de travailler avec ton code, encore merci.
@Toine, merci de ta réponse, je vais tenter quelque chose avec, mais il me semble un brin répétitif, je vais voir ce que je peux faire, merci.

Cordialement, arkhang.

[Marc-L]

Voir les règles du forum certainement pas lues !


Ma solution étant de toute manière extrêmement proche de celle de Daniel …

[Daniel.C]

Ben oui, ça ajoute des lignes; ce sont mes lignes de résultat. J'ai modifié la macro pour mettre les résultat à partir de F1. Fais attention aux "faux" doublons. Tu as beaucoup d'espaces dans tes cellules.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub test()
    'Option Base 1
    Dim Dico As Object, Tabl As Variant, TablA(), Ctr As Long
    Dim Txt As String, Result() As String
    Set Dico = CreateObject("Scripting.Dictionary")
    Tabl = Range([A1], Cells(Rows.Count, 1).End(xlUp)).Resize(, 4)
    TablA = Range([A1], Cells(Rows.Count, 1).End(xlUp))
    For i = 1 To UBound(TablA)
        Txt = Tabl(i, 1) & "***" & Tabl(i, 2) & "***" & Tabl(i, 3)
        If Not Dico.exists(Txt) Then
            Dico.Add Txt, Txt
            Ctr = Ctr + 1
            ReDim Preserve Result(4, Ctr)
            If Result(4, Ctr) = "" Then Result(4, Ctr) = 0
            Result(1, Ctr) = Tabl(i, 1)
            Result(2, Ctr) = Tabl(i, 2)
            Result(3, Ctr) = Tabl(i, 3)
            Result(4, Ctr) = Result(4, Ctr) + Tabl(i, 4)
        Else
            Var = Application.Match(Txt, Dico.items, 0)
            Result(4, Var) = Result(4, Var) + Tabl(i, 4)
        End If
    Next i
    [F1].Resize(UBound(Result, 2), 4) = Application.Transpose(Result)
End Sub