Addition avant suppression des doublons

  • Initiateur de la discussion steeve
  • Date de début
S

steeve

Guest
Bonjouuuuuuuuuuuuuuurrr,

Je tiens d’abord à préciser que je suis novice,

1 L 10 100
1 L 10 100
1 L 10 100
2 L 10 100
2 L 10 100
3 L 10 100
3 L 10 100
5 L 10 100
7 L 10 100
8 L 10 100

Voila j’ai le tableau Excel ci-dessus, il me faudrait une macros me permettant de repérer les doublons, cumuler leur montants et juste après de les supprimer. Donc après passage de la macro je devrai obtenir ca :

1 L 30 300
2 L 20 200
3 L 20 200
5 L 10 100
7 L 10 100
8 L 10 100

------------------------code vba de la macro--------------------------

Sub SupprDoublons()
Dim plage As Range
Dim NBlignes As Long

'Tri du tableau sur le colonne 1
Range("A2").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

'calcul du nombre de lignes
Set plage = Range("a2", [a2].End(xlDown))
NBlignes = plage.Count

'Positionnement du curseur sur la dernière ligne
ActiveCell.Offset(NBlignes - 1, 0).Range("a1").Select

For I = 1 To NBlignes
If ActiveCell.Value = ActiveCell.Offset(-1, 0) Then

'Copier la cellule montant(2)
ActiveCell.Offset(-1, 3).Cells().Copy

'L'Aditionner à la cellue precédente
ActiveCell.Offset(0, 3).Cells().PasteSpecial xlPasteAll, xlPasteSpecialOperationAdd
Application.CutCopyMode = False

'Revenir sur la collonne clé
ActiveCell.Offset(0, -3).Range("A1").Select

'Supprimmer la ligne
ActiveCell.Offset(-1, 0).EntireRow.Cells().Select
Selection.Delete Shift:=xlUp

End If

'Remonte le curseur d'une ligne
ActiveCell.Offset(-1, 0).Range("A1").Select


Next I
End Sub

------------------------------------------fin code macro-----------------------------------
Mais la…… ;!!! Je suis bloquer, elle plante……j’ai une erreur soit au niveau de :

For I = 1 To NBlignes
If ActiveCell.Value = ActiveCell.Offset(-1, 0) Then

Soit au niveau:

Remonte le curseur d'une ligne
ActiveCell.Offset(-1, 0).Range("A1").Select

Cependant quand je fait l’impasse sur l’erreur et que j’exécute la macros 2 fois de suite j’obtiens le résultat voulu.

Si quelqu’un pouvais me filer un coup de main….c pour mon boulot, je suis stagaire….se serai super cool

Merci d’avance.
 
M

Munchkin

Guest
Cest la bordelle aujourd'hui

ARRETER de poster les question plusieurs fois

Steeve il faut lire la charte du forum avant de poster vos message

Le forum est fait pour tout le monde et non pas seulement pour toi donc une fois tu poste ton message
<http://www.excel-downloads.com/html/French/forum/messages/1_108223_108223.htm>

tu ne le poste pas une deuxieme surtout que ton message est encore parmis les quatre premiers

STOP STOP
Mucnhkin
 

Discussions similaires

  • Question
Microsoft 365 Code VBA
Réponses
2
Affichages
296
Réponses
2
Affichages
536
Réponses
21
Affichages
888