Regroupé les doublons d'une liste et incrémenter une valeur

moustiik

XLDnaute Nouveau
Bonjour!
je reviens (une fois de plus^^) vers vous :) question du jour bonjour!!

voilà après avoir avancé dans mes petites affaires, avoir réussi à transférer ce que je voulais transférer il me reste quelques petites choses à améliorée^^

donc je me retrouve avec un fichier du style:

carotte / 1
poireau / 1
tomate / 1
poireau / 1

et je voudrais avoir une macro qui regrouperait mes doublons de manière à avoir

carotte / 1
poireau / 2
tomate / 1

je vous joins le fichier excel d'exemple

cordialement,
une inculte d'excel qui admire vos compétences!
 

Pièces jointes

  • exemple trie des doublons.xlsx
    9.3 KB · Affichages: 314

Dranreb

XLDnaute Barbatruc
Re : Regroupé les doublons d'une liste et incrémenter une valeur

Bonjour.
Difficile de voir ce qui s'est passé sur une suppression de doublons déjà effectuée. Il faudrait pouvoir reproduire le cas sur une liste où elles n'est pas encore faite et où la colonne J est encore correcte
 

Dranreb

XLDnaute Barbatruc
Re : Regroupé les doublons d'une liste et incrémenter une valeur

VB:
Sub SuppressionDesDoublons()
 With Feuil1.Rows(2).Resize(Feuil1.Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1)
     .Sort Key1:=.Columns(5), Order1:=xlAscending, Key2:=.Columns(8), Order2:=xlAscending, _
         Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
     .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(4), Order2:=xlAscending, _
         Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
     .Sort Key1:=.Columns(6), Order1:=xlAscending, Key2:=.Columns(9), Order2:=xlAscending, _
         Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
     .Columns(16).FormulaR1C1 = "=AND(RC1=R[-1]C1,RC4=R[-1]C4,RC5=R[-1]C5,RC6=R[-1]C6,RC8=R[-1]C8,RC9=R[-1]C9)"
     If Not WorksheetFunction.Or(.Columns(16)) Then MsgBox "Aucun doublon détecté.", _
         vbInformation, "SuppressionDesDoublons": GoTo Fin
     .Columns(15).FormulaR1C1 = "=RC10+IF(R[1]C16,R[1]C,0)"
     .Columns(14).FormulaR1C1 = "=IF(RC16,""Suppr"",RC15)"
      Columns(10).Value = .Columns(14).Value
     .Columns(10).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
     End With
Fin: Feuil1.[K:P].Delete
End Sub
Remarque: si vous tenez à ne pas utiliser la propriété Sort de l'objet Worksheet permettant de faire le tri en une seule passe dans les nouvelles versions d'Excel (que je n'aurai pas pour encore un bout de temps), vous pourriez quand même le faire en deux passes seulement avec la méthodes Sort de l'objet Range: elle permet en effet une 3ième et ultime paire Key3, Order3. 2 × 3 vaut quand même mieux que 3 × 2 !
 

NektarMinuit

XLDnaute Nouveau
Re : Regroupé les doublons d'une liste et incrémenter une valeur

Dans excel manuellement j'ai opté pr le tri sur les colonnes à plusieurs niveaux.
Le résultat est quasiment parfait dans le sens où on retrouve bien la même somme de charge avant après. Cependant, il y a un décalage d'une cellule sur la charge et toujours l'apparition des dièses N/A.
Tu peux le constater aussi via le fichier ci joint.
A quoi ils sont dûs ces dièses N/A? Ils m'enquiquinent serieusement ceux là !!!
 

Pièces jointes

  • Classeur28.xlsm
    19 KB · Affichages: 60

Dranreb

XLDnaute Barbatruc
Re : Regroupé les doublons d'une liste et incrémenter une valeur

Manque un point devant Columns(10) = de sorte qu'il garnit la 10ième colonne de la feuille active au lieu de la 10ième colonne de la plage Feuil1.Rows(2).Resize(Feuil1.Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1) du With.
Je m'aperçois seulement maintenant que l'erreur était déjà dans mon dernier code fourni, et je ne sais plus si elle y était dans mon précédent ou si je l'ai reprise du votre.
 

Discussions similaires

Réponses
1
Affichages
1 K

Statistiques des forums

Discussions
312 211
Messages
2 086 284
Membres
103 170
dernier inscrit
HASSEN@45