Fusionner des lignes identiques

[JacquesH]

Bonjour à toutes et tous,

J'ai, une fois de plus, atteint les limites de mes maigres progrès en
VBA et j'ai besoin d'aide.

J'ai un fichier avec environ 500 lignes :
En colonne A : des dates par ordre chronologique.
En colonne B : des noms.
En colonne C : des prénoms.
En colonne D : des nombres
Dans les colonnes suivantes : des informations diverses.

Parfois, des lignes qui se suivent sont exactement identiques en
colonne A à C : même date, mêmes noms et prénoms. Le plus souvent, ce
sont deux lignes consécutives qui sont identiques, mais cela peut-être
trois ou quatre.

Dans ce cas, je souhaite fusionner les x lignes identiques pour la
date, même chose pour les noms et prénoms et je souhaite calculer la
somme en colonne D (avec fusion également).

Exemple :
Avant :

A B C D E F
16 21/04 DURAND Joseph 20 A toto
17 21/04 DURAND Joseph 50 B titi
18 21/04 DURAND Joseph 10 C tata

Après fusion :
16 A toto
17 21/04 DURAND Joseph 80 B titi
18 C tata

Il faut sans doute faire une boucle pour passer en revue toutes les
lignes et lorsque deux ou trois ou quatre sont semblables lancer la
fusion des cellules concernées et l'addition en colonne D, mais je ne
sais vraiment pas comment faire.

Merci par avance de votre aide.

Jacques

[anonymousA]

bonjour,

si j'ai bien compris, la comparaison doit s'effectuer sur la correspondance
, entre les lignes , de la concaténation des colonnes A à C

Sous ces conditions, le programme suivant peut-être à adapter en fonction
notamment de la ligne de départ I=1

Sub nn()

I = 1

While I <> Range("A65536").End(xlUp).Row

tampon = ""
Cpte = 0

For J = 1 To 3
tampon = tampon & Cells(I, J).Value
Next

deb = I

tampon1 = tampon
While tampon1 = tampon
tampon1 = ""
I = I + 1
For J = 1 To 3
tampon1 = tampon1 & Cells(I, J).Value
Next
Cpte = Cpte + 1
Wend

If Cpte > 1 Then
Application.DisplayAlerts = False
Range(Cells(deb, 1), Cells(deb + Cpte - 1, 1)).Merge
Range(Cells(deb, 2), Cells(deb + Cpte - 1, 2)).Merge
Range(Cells(deb, 3), Cells(deb + Cpte - 1, 3)).Merge
Valeur = Application.WorksheetFunction.Sum(Range(Cells(deb, 4),
Cells(deb + Cpte - 1, 4)))
Range(Cells(deb, 4), Cells(deb + Cpte - 1, 4)).Merge
Cells(deb, 4).Value = Valeur
Range(Cells(deb, 1), Cells(deb + Cpte - 1, 4)).VerticalAlignment =
xlCenter
Application.DisplayAlerts = True
End If

Wend

End Sub

A+

"JacquesH" a écrit :

[JacquesH]

Bonjour et merci de t'intéresser à mon problème,

J'ai copier ta macro dans un module de mon fichier, j'ai mis mes
données à partir de la ligne 1, mais rien ne se passe.

Je ne sais pas si tu travailles de cette manière, mais j'ai mis un
fichier exemple dans Cjoint :
http://cjoint.com/?eskzlHlHtf

Jacques

anonymousA a écrit :

[anonymousA]

re,

je regarde ce soir.

[JacquesH]

Re-

Erreur de ma part, j'ai fait un nouvel essai et tout fonctionne.

En revanche, je ne comprends pas tout ce que tu as fait. Si tu pouvais
me donner quelques explications sur le code car évidemment mon fichier
est un peu plus complexe que cela.

Merci

Jacques

anonymousA a écrit :

[anonymousA]

re,

Sub nn()

I = 1 'on part de la la ligen 1

While I <> Range("A65536").End(xlUp).Row 'tant que la dernière ligne non
'vide de la colonne A n'a pas été atteinte

'on réinitialise dans la boucle while les variables 'tampon et Cpte car
'elles son réutilisées à chaque boucle et ne doivent 'pas oserver leurs
'anciennes valeurs

tampon = ""
Cpte = 0
For J = 1 To 3

tampon = tampon & Cells(I, J).Value 'on concatene les valeurs
des 'cellules des colonnes A, B et C
Next
deb = I 'on a besoin de conserver la valeur de I initiliale car
'on va faire une bouvcle tant que pour savoir le nbre de lignes
'identiques
tampon1 = tampon 'par défaut on porte tampon1=tampon pour
'permettre l'entrée dans la boucle while ce qui serait plus difficile
'autrement
While tampon1 = tampon 'dans la boucle suivante, on va simplement
'chercher à comparer l'identité des lignes en fonction de la 1ere ligne
'correspondant à un I différent

tampon1 = ""
I = I + 1
For J = 1 To 3
tampon1 = tampon1 & Cells(I, J).Value
Next
Cpte = Cpte + 1
Wend

'Dans ce qui suit, si CPte>1 ca veut dire qu'il y a au moins
'une ligne identique par rapport au I de la 1ere boucle while
'Il faut donc désormais procéder à la fusion des cellules.PAr défaut
'quand Excel procède à une fusion, il récupère la cellule le + en haut à
'gauche comme valeur de la plage fusionnée. Il n'est donc pas necessaire
'de se casser la tête pour les colonnes A , B et C .POur eviter le
'message d'alerte pour nous prévenir on l'invalide par
'Application.displayalerts=false
'Par contre,pour la colonne D, il faut procéder à la somme de la plage à
'fusionner avant de fusionner les cellules. C'est ce que fait le
'worksheetfunction Sum.

If Cpte > 1 Then
Application.DisplayAlerts = False
Range(Cells(deb, 1), Cells(deb + Cpte - 1, 1)).Merge
Range(Cells(deb, 2), Cells(deb + Cpte - 1, 2)).Merge
Range(Cells(deb, 3), Cells(deb + Cpte - 1, 3)).Merge
Valeur = Application.WorksheetFunction.Sum(Range(Cells(deb, 4),
Cells(deb + Cpte - 1, 4)))
Range(Cells(deb, 4), Cells(deb + Cpte - 1, 4)).Merge
Cells(deb, 4).Value = Valeur
Range(Cells(deb, 1), Cells(deb + Cpte - 1, 4)).VerticalAlignment =
xlCenter
Application.DisplayAlerts = True
End If

Wend

End Sub

Voilà c'est fini

A+
JacquesH a écrit :

[JacquesH]

Bonjour,

Merci encore une fois.

Je suis vraiment épaté, ébloui... par ce que vous faîtes ainsi que par
vos disponibilité et gentillesse.

Bonne journée

Jacques.

anonymousA a écrit :