Macro somme doublons n'opère plus

[argaz01]

Bonjour tout le monde,


J'ai réalisé une macro (avec l'aide de la communauté) la semaine dernière, cependant cette dernière ne s'applique sur tout mon tableau! La macro en question est censée trier et faire la somme des doublons présents dans mon tableau, le but étant de faire un graphique à la fin. Voici la macro ainsi que le tableau en question en pièce jointe:

Sub TriSommeAMF()
Dim ligne As Integer
ligne = 2
Do
 
  If Cells(ligne, 1) = Cells(ligne + 1, 1) And Cells(ligne, 2) = Cells(ligne + 1, 2) Then
  Cells(ligne, 3) = Cells(ligne, 3) + Cells(ligne + 1, 3)
    Cells(ligne + 1, 3).EntireRow.Delete Shift:=xlUp
  Else
    ligne = ligne + 1
  End If
Loop While Cells(ligne, 1) <> ""

End Sub

 

[GBI]

Re : Macro somme doublons n'opère plus

Bonjour Argaz,
Il semblerait que ta pièce jointe ne soit pas jointe 🙂
Cdt

 

[camarchepas]

Re : Macro somme doublons n'opère plus

Bonjour GBI,

Lol , je confirme la colle n'a pas tenue, et la pièce jointe n'est plus....

 

[argaz01]

Re : Macro somme doublons n'opère plus

Merci les gars, voilà de nouveau ma pièce jointe

 

[job75]

Re : Macro somme doublons n'opère plus

Bonjour le fil,

La macro dans le code de Feuil1 (clic droit sur l'onglet et visualiser le code) :

Private Sub CommandButton1_Click()
Dim i&, j&
Application.ScreenUpdating = False
[A:B].Copy [E:F]
For i = Range("E65536").End(xlUp).Row To 3 Step -1
  For j = i - 1 To 2 Step -1
    If Cells(i, "E") = Cells(j, "E") Then
      Cells(j, "F") = Cells(j, "F") + Cells(i, "F")
      Cells(i, "E").Resize(, 2).Delete xlUp
      Exit For
    End If
  Next
Next
End Sub

Fichier joint.

Edit : j'avais oublié Exit For...

A+

 

[camarchepas]

Re : Macro somme doublons n'opère plus

Bonjour Job,
Super maitrise, j'ai quand même du mal à tout comprendre le fonctionnement,
je me la mets derrière l'oreille pour l'analyser plus tard.

J'ai écrit plus conventionnellement, et comme j'ai fais je poste :


Sub TriSomme()
Dim Pointeur As Long
Dim Lecture As String, Mem As String
'Tri l'ensemble du tableau
Range("A1:B" & Range("A65536").End(xlUp).Row).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Regroupe et additionne
Pointeur = 2
Mem = ""
'Boucle de scrutation
Do
Lecture = Range("A" & Pointeur)
If Lecture = Mem Then
Range("B" & Pointeur - 1) = Range("B" & Pointeur - 1) + Range("B" & Pointeur)
Rows(Pointeur).Delete
Else
Mem = Lecture
Pointeur = Pointeur + 1
End If
Loop Until Lecture = ""
End Sub

 

[pierrejean]

Re : Macro somme doublons n'opère plus

Bonjour argaz01
Salut GBI
Salut Job
Salut camarchepas (Qu'est-ce que le conventionnel ?)

ma version:

Sub modifie()
For n = Range("A65536").End(xlUp).Row To 2 Step -1
 For m = n - 1 To 1 Step -1
   If Range("A" & m) = Range("A" & n) Then
      Range("B" & m) = Range("B" & m) + Range("B" & n)
     Rows(n).Delete
   End If
 Next m
Next n
End Sub

 

[camarchepas]

Re : Macro somme doublons n'opère plus

Bonjour Jean Pierre,

Oui tu as raison , tout est une histoire de cadre de référence, en programmation heureusement , il existe mille façons de faire la même chose .
Bon , je vois que la double boucle est de rigueur .

 

[argaz01]

Re : Macro somme doublons n'opère plus

Merci les gars ça marche nickel! Encore merci