Discussion :

[Invité]

Bonjour,

Je cherche à supprimer les doublons d’un tableau (non trié) en conservant pour chaque doublon un exemplaire et à sommer les valeurs d’une colonne leurs correspondant, le tout en VBA !

Voici un exemple illustré de ce je cherche à faire :
Dans le premier tableau ci-dessous, on y trouve les doublons DUPONT et MARTIN. La valeur des abonnements est toujours le même pour un vendeur donné. En revanche, la valeur des licences est différente pour un vendeur donné :


Ce que je voudrais faire est de « fusionner » les lignes DUPONT (dans le même tableau), en conservant la valeur 25 dans abonnements mais en sommant les valeurs des licences lui correspondant. De la même manière pour MARTIN. On obtiendrait le tableau ci-dessous :


J’ai un code qui fonctionne si et seulement le tableau est classé par ordre alphabétique mais je ne souhaite pas le trier…
Pouvez-vous m’aider, s’il vous plait ?

[Marc-L]

Bonjour,

conformément au règles de ce forum, poster le code balisé via l'icône dédiée # !

Et pourquoi donc ne pas vouloir trier ? C'est la solution la plus simple et la plus rapide !


_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

[boisgontierjacques]

Bonjour,

J’ai un code qui fonctionne si et seulement le tableau est classé par ordre alphabétique mais je ne souhaite pas le trier…

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
Sub SousTotalNonTrié()
  Set d1 = CreateObject("Scripting.Dictionary")
  a = Range("A2:C" & [a65000].End(xlUp).Row)
  j = 0
  For i = LBound(a) To UBound(a)
     If Not d1.exists(a(i, 1)) Then j = j + 1: d1(a(i, 1)) = j
  Next i
  Dim b(): ReDim b(1 To d1.Count, 1 To UBound(a, 2))
  For ligne = LBound(a) To UBound(a)
    p = d1(a(ligne, 1))
    b(p, 2) = b(p, 2) + a(ligne, 2)
    b(p, 3) = a(ligne, 3)
    b(p, 1) = a(ligne, 1)
  Next ligne
  [E11].Resize(UBound(b), UBound(b, 2)) = b
End Sub

ou

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Total()
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    d1(c.Value) = d1(c.Value) + c.Offset(, 1)
    d2(c.Value) = c.Offset(, 2)
  Next c
  [e2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
  [f2].Resize(d1.Count, 1) = Application.Transpose(d1.items)
  [g2].Resize(d1.Count, 1) = Application.Transpose(d2.items)
End Sub

Boisgontier

[Invité]

Merci pour cette réponse si rapide !

Est-il possible de ne pas créer de deuxième tableau mais simplement fusionner dans le même tableau?

[Marc-L]

Effacer le contenu du tableau (propriété ClearContent) avant de copier le résultat …

Sinon en triant la liste donc sans dictionnaire avec une simple variable tableau pas besoin d'effacer au préalable !


_____________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[Invité]

Merci pour vos réponses, j'ai décidé d'opter pour la solution de création d'un second tableau.

Bonne journée !