Addition avant suppression des doublons

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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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.
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
2
Affichages
737
  • Question Question
Microsoft 365 Code VBA
Réponses
2
Affichages
517
Retour