Fusionner des cellules si identiques (adjacentes ou non)

Question

Bonjour, 

Tout d'abord merci à tous pour votre aide, ce n'est pas la 1ère fois que je viens ici pour solliciter vos lumières !

Je suis sur un fichier excel où dans une plage je voudrai fusionner les cellules adjacentes identiques, elles proviennent de formules.
C'est une sorte de calendrier/planning que je fais pour mon équipe au boulot, je voudrai rendre sa lecture plus agréable...

Je vous ai mis une version simplifiée pour vous exposer le problème, voici le lien :   http://cjoint.com/data/0FtpK5uyDv1.htm

Je me suis inspiré d'une macro sur un forum mais comprend assez mal toutes les formules .... -_-"

Merci d'avance à vous !!

Axel


PS: si je mets "Adjacente ou non" c'est car dans mon fichier, une case sur 2 est vide suite à une formule qui octroie la valeur vide ("") à la cellule. 

Donc si j'ai : "" - 2014 - "" - 2014 - "" 2015 - "" - 2015 ,
J'aimerai obtenir 2014 (4 cellules) - 2015 (4 cellules).

Si vous savez comment faire ceci, je suis tout ouïe :)

Whismeril · Answer

Bonjour, il serait préférable que tu postes la partie de code qui te pose problème. Voirici comment utiliser la coloration syntaxique.

Tu comprendras que beaucoup soient rétissants à télécharger un fichier xls sans garantie de fiabilité.

Axeu · Answer

Bonjour Whismeril,

Désolé pour la faute, voici le code : 

Sub FUSION() Dim Cel As Range, Plg As Range Dim DerCol As Byte, NbCol As Byte Set Plg = Range("E6:S10") Application.ScreenUpdating = False Plg.Value = Plg.Value For Each Cel In Plg.SpecialCells(xlCellTypeConstants, 23)     If Not Cel.MergeCells Then         DerCol = Cel.End(xlToRight).Column + 1         NbCol = Application.CountIf(Range(Cel, Cel.Resize(1, DerCol - Cel.Column)), Cel)         Application.DisplayAlerts = False         Cel.Resize(1, NbCol).Merge     End If Next Cel   End Sub


Le fichier sans macro :  http://cjoint.com/data/0Ftp56nBId7.htm

jordane45 · Answer

Bonjour,

Le mieux est de le faire Ligne par ligne et non pas sur une Zone complete de  ton classeur..

Function FUSION_Rows(Numligne As Integer)

Dim Cel As Range, Plg As Range
 Dim DerCol As Byte, NbCol As Byte
 Set Plg = Range("E" & Numligne & ":S" & Numligne)
 Application.ScreenUpdating = False
 Plg.Value = Plg.Value
 For Each Cel In Plg.SpecialCells(xlCellTypeConstants, 23)
 Debug.Print Cel.Address
      If Not Cel.MergeCells Then
         'DerCol = Cel.End(xlToRight).Column + 1
         DerCol = Cells.Find("*", Range(Cel.Address), , , xlByColumns, xlPrevious).Column + 1
         NbCol = Application.CountIf(Range(Cel, Cel.Resize(1, DerCol - Cel.Column)), Cel)
         Application.DisplayAlerts = False
         Cel.Resize(1, NbCol).Merge
     End If
 Next Cel

End Function

Sub FUSION()

FUSION_Rows (6)
FUSION_Rows (7)
FUSION_Rows (9)
FUSION_Rows (10)

' Attention... On ne met pas les lignes VIDES !

End Sub

J'ai aussi modifié ta fonction pour obtenir la dernière colonne..

Axeu · Answer

Bonjour Jordane45,

Merci d'avoir pris du temps pour regarder mon problème !

J'ai essayé ta macro mais j'ai l'erreur 1004 qui s'affiche sur la ligne suivante, sans aucune fusion effectuée:
NbCol = Application.CountIf(Range(Cel, Cel.Resize(1, DerCol - Cel.Column)), Cel)

Dans les 2 lignes de ton code ci-dessous, j'ai remis la "mienne" et mis en commentaire la tienne: 

'DerCol = Cel.End(xlToRight).Column + 1DerCol = Cells.Find("*", Range(Cel.Address), , , xlByColumns, xlPrevious).Column + 1 

Comme ceci, la fusion s'opère et semble réussie, sauf que c'est un calendrier sur 1 an, donc les noms de jours et numéros de mois ont plusieurs occurences sur leur ligne.
Donc sur 1 mois et demi, si j'ai 6 Lundi, la fusion censée se faire par 2 cellules se fait sur 6 x 2 cellules, on voit donc des fusions de 6 cellules, puis de 5, de 4 ...jusqu'à 2 (ce qui est attendu pour ces lignes ci).

Pour les jours du mois, sur N mois j'ai N fois le jour 4 par exemple, donc cela va se fusionner par Nx2 au lieu de 1x2, plus loin par (N-1)x2, puis          (N-3)x2 ....


En bref la fusion s'étend proportionnellement au nombre d'occurence de la valeur à fusionner, et s'étend un peu moins à chaque cycle fait (1 mois pour les n° de jours, 1 semaine pour les nom de jours...)

Le fichier sans macro, elle est écrite sous le tableau : http://cjoint.com/data/0FukQsYVIyV.htm

(PS: j'ai adapté la plage cible de la macro quand j'ai allongé mon tableur)

C'est un peu confu je sais mais je vous remercie pour votre patience ! :)

Axel.

Axeu · Answer

Messieurs j'ai trouvé la solution ! 

Jordane45, l'erreur provenait de :
DerCol = Cells.Find("*", Range(Cel.Address), , , xlByColumns, xlPrevious).Column + 1

  Etant donné que mon tableur commence en colonne E, DerCol était inférieur à Cel.column, donc NbCol était une valeur négative à la 1ère itération de la boucle donc le resize(1,"valeur négative") ne fonctionnait pas.

J'ai donc mis :
DerCol = Cells.Find("*", Range(Cel.Address), , , xlByColumns, xlPrevious).Column + 1 + 4 ' décalage de A à D

Merci à tous pour le temps que vous m'avez octroyé, c'est parfait !!

Axel.

Axeu · Answer

En fait non, ça ne marche pas ...

C'est OK pour les noms et n° de jours, même s'ils y a plusieurs occurences il n'y a pas de soucis, mais pour ma ligne d'année, j'ai "2014" sur 100 colonnes et 2015 sur 12, il me fusionnes par lots de 2 d'abord, puis par lots de 4 jusqu'à la fin 2014, puis par lots de 4 toujours pour 2015...

Je suis paumé avec cette fonction :s

Fusionner des cellules si identiques (adjacentes ou non)

6 réponses

Votre réponse

Discussions similaires