Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Suppression et addition de doublons

Créer une discussion

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'inscrire
J

JMR150

XLDnaute Nouveau
Bonjour à tous,

Je rencontre un problème avec mon fichier. En effet, je cherche à supprimer les doublons et à additionner les valeurs correspondantes. J'ai écrit mon code comme suit :
Code: 
Sub supDoublonsTotal()
With Sheets("Feuil2")
Dim L_fin As Integer
L_fin = Range("A65536").End(xlUp).Row
  ligne = 1
  Range(Cells(1, 1), Cells(L_fin, 1)).Sort Key1:=Cells(L_fin, 1), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  Do While Cells(ligne, 1) <> ""
     If Cells(ligne, 1) = Cells(ligne + 1, 1) Then
        Cells(ligne, 2) = Cells(ligne, 2) + Cells(ligne + 1, 2)
        Rows(ligne + 1).Delete
     Else
        ligne = ligne + 1
     End If
  Loop
End With
End Sub

Petit hic : en faisant quelques essais, j'ai remarqué que le code marchait très bien sans la partie de tri des valeurs :

Code: 
Range(Cells(1, 1), Cells(L_fin, 1)).Sort Key1:=Cells(L_fin, 1), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

Il faut donc que je passe par le tri manuel des valeurs. Je voudrais éviter cette manipulation car je compte utiliser ce code pour un tableau beaucoup plus important.

Pouvez-vous me dire ce qui cloche s'il vous plaît ?

Merci d'avance 😉
 

Pièces jointes

Trier par date Trier par votes
Re : Suppression et addition de doublons

Bonjour,

Essaie comme cela
Code: 
Sub supDoublonsTotal()
Dim L_fin As Long, Ligne As Long
    With Sheets("Feuil2")
        L_fin = .Range("A65536").End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(L_fin, 1)).Sort Key1:=.Cells(L_fin, 1), Order1:=xlDescending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        For Ligne = L_fin To 2 Step -1
           If .Cells(Ligne, 1) = .Cells(Ligne - 1, 1) Then
              .Cells(Ligne - 1, 2) = .Cells(Ligne, 2) + .Cells(Ligne - 1, 2)
              .Rows(Ligne).Delete
           End If
        Next Ligne
    End With
End Sub

A+
 
Vote positif 0 Vote négatif
Re : Suppression et addition de doublons

Même problème : les données ne sont pas cohérentes.
Par exemple pour "T" qui revient deux fois, la somme devrait être égale à 11. Et quand j'exécute la macro, ça donne 80.
Quand je mets la partie du tri en commentaire dans le code et que je trie manuellement la colonne A en Feuil2, là y'a pas de soucis, ça additionne correctement.
Je ne comprends pas 😕
 
Vote positif 0 Vote négatif
Re : Suppression et addition de doublons

J'ai finalement trouvé une solution, même si elle n'est pas très propre car elle parcourt toute la colonne en ne détectant pas la dernière ligne mais elle parcourt le fichier jusqu'à la ligne 65536.. Bon pas très subtil mais au moins ça marche.🙄
Code: 
Sub supDoublonsTotal()
With Sheets("Feuil2")
ligne = 1
With ActiveWorkbook.Worksheets("Feuil2").Sort
        .SetRange Range("A1:B65536")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
  Do While Cells(ligne, 1) <> ""
     If Cells(ligne, 1) = Cells(ligne + 1, 1) Then
        Cells(ligne, 2) = Cells(ligne, 2) + Cells(ligne + 1, 2)
        Rows(ligne + 1).Delete
     Else
        ligne = ligne + 1
     End If
  Loop
End With
End Sub

Si vous avez mieux, je suis preneuse 😉
 
Vote positif 0 Vote négatif
Re : Suppression et addition de doublons

Effectivement, il faut que la plage prenne en compte les 2 colonnes
Code: 
        .Range(.Cells(1, 1), .Cells(L_fin, 2)).Sort Key1:=.Cells(L_fin, 1), Order1:=xlDescending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal

A+
 
Vote positif 0 Vote négatif
Re : Suppression et addition de doublons

bonjour tous 🙂
on pourrait ecrire comme cela egalement

Code: 
Sub es()
  Dim t(), i As Long, m As Object
  Set m = CreateObject("Scripting.Dictionary")
  With Feuil3
  t = .Range("a1:b" & .Cells(Rows.Count, 1).End(3).Row)
  For i = 1 To UBound(t)
  m(t(i, 1)) = m(t(i, 1)) + t(i, 2)
  Next i
  .Range("a1:b" & .Cells.Find("*", , , , , xlPrevious).Row).ClearContents
  .[a1].Resize(m.Count) = Application.Transpose(m.keys)
  .[b1].Resize(m.Count) = Application.Transpose(m.Items)
  .[a1:b100000].Sort Key1:=.[a1], Order1:=xlAscending, Header:=xlGuess
  End With
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

Discussions similaires

A
  • Question Question
XL 2021 listbox
2
Réponses
18
Affichages
429
Dranreb
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
674
TooFatBoy
  • Question Question
Microsoft 365 VBA ADODB doublons
Réponses
1
Affichages
251
dysorthographie
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
26
Affichages
895
Webperegrino
W
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
528
kiki29
M
  • Question Question
XL 2016 liste déroulante formulaire vba excel
2
Réponses
20
Affichages
677
fanch55
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
388
AtTheOne
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
446
Abi23
A
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
975
CortoXls
C
C
  • Résolu(e)
XL 2010 Delete
Réponses
5
Affichages
562
job75
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
1 K
Gestionnaire_rh
G
R
  • Question Question
XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur
Réponses
1
Affichages
539
Aya_flo
A
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
1 K
MICHAEL
M
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
1 K
laurent950
R
  • Question Question
XL 2019 Transpose et limiter nombre de valeur
Réponses
1
Affichages
407
Rabeto
R
C
  • Question Question
XL 2013 Macro décale d'une colonne
Réponses
1
Affichages
549
candido57
C
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
C
  • Question Question
Microsoft 365 Lenteur macro mise en page
Réponses
7
Affichages
276
CortoXls
C
S
  • Résolu(e)
Microsoft 365 Boucle pour afficher et masquer des lignes
Réponses
12
Affichages
738
shf
S
  • Question Question
Microsoft 365 Trier des données et les afficher sur une autre feuille
Réponses
10
Affichages
580
Jojo973
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…