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

[moustiik]

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!

 

[laetitia90]

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

bonjour tous
comme je comprends !!!!
2 macros qui font a peu pres la meme chose
pas optimiser les boucles a voir deja.. si cela peut correspondre a ta demande

 

[NektarMinuit]

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

Dranreb, merci pour ce complément d'informations, j'en attendais pas moins. Merci bien.
Je teste et te dis si cela a fonctionné et que je n'ai pas fait explosé excel ou mon ordi ou les deux. !!!

 

[NektarMinuit]

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

Bonjour Laetitia90,
Dans la colonne E d'après ce que je vois c'est que tu t'es servie de cette colonne vide afin d'y mettre que les valeurs uniques. Ce que je voulais en soit puisqu'après dédoublement je suis bien en face d'un même total et des lignes uniques en revanche les lignes originelles sont toujours présentes dans les premières colonnes. Et c'est ce qui est facheux !!!
Mais un grand merci à toi car moi même n'arrive même pas à faire le 10 ième et cela m'est bien nuisible !!!
On ne peut pas être parfait partout lol !!!!
Bonne journée
NM

 

[laetitia90]

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

re,tous

si cela pose pb !!!
change cette ligne

Range("e2:g" & Cells(Rows.Count, 1).End(3).Row).ClearContents

par

 Range("a2:g" & Cells(Rows.Count, 1).End(3).Row).ClearContents

apres tu peus ecrire le resultat ou tu veus j'ai pris e2 tu peus prendre a2

 [e2].Resize(a, 1) = t1

 

[NektarMinuit]

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

me revoilàaprès quelques minutes d'essais.
Dranreb, j'ai adapté à mes colonnes et lancer la procèdure uniquement sur 20000 lignes pas à pas.
Mes colonnes sont les suivantes FICHIER/dESCRIPTIF/n°/Séquence/ressource/DPT/METIER/Date de début/Date de fin/Charge
A la ligne .Columns(16).FormulaR1C1 = "=AND(RC1=R[-1]C1,RC2=R[-1]C2,RC3=R[-1]C3,RC4=R[-1]C4)" , j'ai le message d'erreur suivant Erreur d'excution 1004.
Je t'envoie le code que j'ai adapté, où est l'erreur stp. Toi avec ton eil de lynx!!!! Il faut adapter les formules c'est cela? Sachant sue mes doublons sont toujours portés par sur un m projet pr une m séquence pr une m personne et pr une m date de début, faire le cumul de la charge si doublons identifiés et supprimer les lignes inutiles....bref l'éternel même refrain!!

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
.Columns(16).FormulaR1C1 = "=AND(RC1=R[-1]C1,RC2=R[-1]C2,RC3=R[-1]C3,RC4=R[-1]C4)"
.Columns(15).FormulaR1C1 = "=RC7+IF(R[1]C10,R[1]C9,0)"
.Columns(14).FormulaR1C1 = "=IF(RC10,""Suppr"",RC9)"
.Columns(13).Value = .Columns(8).Value
.Columns(13).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End With
Feuil1.[K].Delete
End Sub

merci infiniment de votre aide et soutien

 

[NektarMinuit]

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

Avec le fichier c'est toujours mieux !!

 

[Dranreb]

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

Les formules n'ont pas été corrigées en conséquence. Mettez Exit Sub après .Columns(14).FormulaR1C1 = "=IF(RC10,""Suppr"",RC9)". Exécutez la procédure. Corrigez les formules pour qu'elles donnent le bon résultat. Enregistrez une nouvelle macro puis revalidez les formules en P2, N2, O2. Arrêtez l'enregistrement de la macro et reprenez les expressions des FormulaR1C1 dans votre code.

Je viens de le faire. Si je n'ai pas commis d'erreur, ça devrait être :

     .Columns(16).FormulaR1C1 = "=AND(RC1=R[-1]C1,RC4=R[-1]C4,RC5=R[-1]C5,RC8=R[-1]C8)"
     .Columns(15).FormulaR1C1 = "=RC10+IF(R[1]C16,R[1]C,0)"
     .Columns(14).FormulaR1C1 = "=IF(RC16,""Suppr"",RC15)"

Après d'ailleurs c'est pas .Columns(13).Value = .Columns(8).Value
.Columns(13).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete, c'est :

     .Columns(10).Value = .Columns(14).Value
     .Columns(10).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete

 

[NektarMinuit]

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

Cà marche du tonnerre de Zeus... bon pour 20 000 lignes je vais essayer 40000 lignes et te dis cela de ce pas !!!

 

[NektarMinuit]

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

Et oui cela fonctionne à merveille pour 41000 lignes car j'ai découpé en 4 feuilles différentes les 120000 lignes.
Je continue sur ma lançée et reviens vers toi dès que cela est fini!!
A +

 

[NektarMinuit]

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

Dranreb, comment te dire que tu es un génie !!!! alors les 120 000 lignes ont bien failli coûter la vie de mon ordinateur mais après qq minutes d'attente, la consécration!!!!!!
Mille mercis !!!! et me voila (même malade....sale grippe:-() requinquée !!!!
A bientôt pr de nouvelles aventures.... dans pas si longtemps histoire que j'améliore mon vba !!!
Bonne soirée
NM

 

[NektarMinuit]

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

Bonsoir,
Et oui me revoilà avec un nouveau challenge (comme si le 1er n'était pas assez compliqué) à savoir qu'à mon dernier fichier, maintenant je dois prendre en considération les colonnes de DPT, Métier, DF dans ma clef. Toujours pr la même chose, m fichier, m séquence, m ressource, m DPT, m métier, m DD et enfin m DF, si doublons on cumule la charge.
Danreb est ce que tu es derrière ton vba pr me venir de nouveau à l'aide?!!!
Merci beaucoup.
NM

 

[NektarMinuit]

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

Dis moi si je me trompe,

.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)"
.Columns(15).FormulaR1C1 = "=RC10+IF(R[1]C16,R[1]C,0)"
.Columns(14).FormulaR1C1 = "=IF(RC16,""Suppr"",RC15)"
Est-ce que je dois ajouter des tris pr les colonnes ajoutées? Ce le me semble logique mais bon....
Cordialement
NM

 

[NektarMinuit]

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

J'ai comme quelque chose quei ne fonctionne pas à savoir je me retrouve avec des dièse N/A en dessous de ma 18ième ligne après suppression des doublons. Qu'est ce?
Voilà mon language


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
.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)"
.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
Feuil1.[K].Delete
End Sub

 

[Dranreb]

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

Boujour.
Mettez un Exit Sub pour la mise au point derrière la dernière affectation de FormulaR1C1 et vérifiez les formules.
À priori aussi vous avez 2 critères de tri en plus à mettre. Enregistrez une nouvelle macro pour le faire en une seule passe et repompez les instructions engendrées. Ça n'existe pas dans ma version d'Excel.

 

[NektarMinuit]

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

Bonjour à toi superman de VBA !!!!
Donc après avoir fait le trij eme rends compte que le problème réside dans la dernière ligne du programme. Elle m'engendre des dièses n/a.
Tout le processus avant est correct, il identifie bien les doublons, fais le cumul de la charge .... bref dans le fichier ci joint, tu pourras voir que jusqu'à la derniè-re ligne tout se passe divinement bien.
LIGNE POSANT PROBLEME
.Columns(10).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete

As tu une idée de ce que cela peut être?
NM