Fusionner des mêmes cellules en ligne
Résolu
Cabrina
Messages postés
273
Statut
Membre
-
pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention -
pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention -
Bonjour à tous,
Je voudrais fusionner plusieurs cellules sur une même ligne (les cellules à fusionner se suivent).
J'ai trouvé une marco (qui fonctionne :))
Mais elle ne fonctionne que sur une ligne j'ai essayer de changé
Mais toujours rien...
Que faut-il que je change d'autre pour que cela fonctionne sur les ligne du dessous.
Sachant que la fusion doit se faire uniquement en ligne jamais en colonne.
Cdlt,
Je voudrais fusionner plusieurs cellules sur une même ligne (les cellules à fusionner se suivent).
J'ai trouvé une marco (qui fonctionne :))
Sub fusion()
Dim co As Long
Dim nbco As Long
Dim plage As Range
Set plage = sheets"(Planning").Range("C22:FQ22")
Application.DisplayAlerts = False
With plage
nbco = .Columns.Count
For co = nbco To 2 Step -1
If .Cells(1, co) = .Cells(1, co - 1) Then
Range(.Cells(1, co), .Cells(1, co - 1)).MergeCells = True
End If
Next co
End With
Application.DisplayAlerts = True
End Sub
Mais elle ne fonctionne que sur une ligne j'ai essayer de changé
Set plage = sheets"(NomDeTaFeuille").Range("C22:FQ23")
Mais toujours rien...
Que faut-il que je change d'autre pour que cela fonctionne sur les ligne du dessous.
Sachant que la fusion doit se faire uniquement en ligne jamais en colonne.
Cdlt,
3 réponses
-
Bonjour,
Quel est l'intérêt de fusionner des cellules?
-
Bonjour,
Je veux fusionner des cellules pour faire un planning avez-vous une autre idée pour ne pas avoir une répétition de la même référence ?- Ci-joint mon fichier.
Je voudrais que mon résultat final soit celui en bleu, pour ce faire une ne voie pas comment faire sans passée par un fusion de mes cellules ?
https://www.cjoint.com/c/GAAlPoq7bFt
-
-
Tu n'as pas mis de feuille "Planning", donc dur dur.
Essaye juste ceci :Sub fusion() Dim Lig As Long Dim co As Long Dim nbco As Long Dim plage As Range Set plage = sheets"(Planning").Range("C22:FQ52") 'A ADAPTER !!! Application.DisplayAlerts = False With plage nbco = .Columns.Count For Lig = .Cells(1, 1).Row To .Cells(1, 1).Row + .Rows.Count - 1 For co = nbco To 2 Step -1 If .Cells(Lig, co) = .Cells(Lig, co - 1) Then .Range(.Cells(Lig, co), .Cells(Lig, co - 1)).Interior.ColorIndex = 3 End If Next co Next Lig End With Application.DisplayAlerts = True End Sub
Essaye d'abord sur une copie de ton fichier, bien sur...
Adapte la plage, et regarde le résultat, sans Merge...
Avant, j'arrivais jamais à finir mes phrases... mais maintenant je-
En adaptant les plages cela ne donne pas ce que mon chef espère était donné que cela me fait une ligne rouge qui va de K19 à VM19
En revanche celle que j’ai mise en premier oui donc je reste sur celle que j’ai trouvée dans le forum par contre le système de couleur n’est pas mal…
Il faut de je mette dans la ligneInterior. Color Index = 3
PS : Y a-t-il y moyen de le mettre à la suite comme ce qu’il avait fait en bleu ? quand la première fusion et fini je passe à la ligne du dessous ?
Je m’explique si ma première fusion commence en F7 et se termine en K7, je voudrais que la deuxième fusion parte de L8 jusqu'en T8 et ainsi de suite.
-
-
Voilà, tout simplement :
Sub fusion3() Dim Wsh As Worksheet Dim Lig As Long Dim PremCol As Long Dim co As Long Dim nbco As Long 'A ADAPTER---------------------------------------------- Lig = 7 'A ADAPTER, ligne ou sont les données PremCol = 6 'A ADAPTER, première colonne Set Wsh = Worksheets("Planning") ' A ADAPTER Feuille concernée 'TRAITEMENT---------------------------------------------- Application.ScreenUpdating = False nbco = Rows(Lig).Find("*", , , , xlByRows, xlPrevious).Column With Wsh For co = PremCol To nbco - 1 If .Cells(7, co) = .Cells(7, co + 1) Then .Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ColorIndex = 3 '.Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ThemeColor = xlThemeColorAccent1 '.Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ThemeColor = xlThemeColorAccent5 Else Lig = Lig + 1 .Cells(Lig, co + 1).Value = .Cells(7, co + 1).Value End If Next co End With Application.ScreenUpdating = True End Sub
J'ai viré tes DisplayAlert inutiles, et mis en commentaires deux lignes. Si ton chef tient au bleu essaye les l'une après l'autre...
Ta plage initiale doit être en ligne 7, à partir de la colonne F dans la feuille Planning. Dans le cas contraire, il faudra adapter ce que j'ai indiqué.
Avant, j'arrivais jamais à finir mes phrases... mais maintenant je-
-
As-tu, au moins, compris le mécanisme du code donné précédemment?
Voici :Sub fusion4() Dim Wsh As Worksheet Dim Lig As Long Dim PremCol As Long Dim co As Long Dim nbco As Long Dim LigFin As Long 'A ADAPTER---------------------------------------------- Lig = 7 'A ADAPTER, ligne ou sont les données LigFin = Lig PremCol = 6 'A ADAPTER, première colonne Set Wsh = Worksheets("Planning") ' A ADAPTER Feuille concernée 'TRAITEMENT---------------------------------------------- Application.ScreenUpdating = False nbco = Rows(Lig).Find("*", , , , xlByRows, xlPrevious).Column With Wsh For co = PremCol To nbco - 1 If .Cells(7, co) = .Cells(7, co + 1) Then .Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ColorIndex = 3 '.Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ThemeColor = xlThemeColorAccent1 '.Range(.Cells(Lig, co), .Cells(Lig, co + 1)).Interior.ThemeColor = xlThemeColorAccent5 Else Lig = Lig + 1 .Cells(Lig, co + 1).Value = .Cells(7, co + 1).Value End If Next co .Range(.Cells(LigFin, PremCol + 1), .Cells(LigFin, nbco)).ClearContents End With Application.ScreenUpdating = True End Sub -
Pas vraiment car je ne suis pas du tout du "milieu" mais je dois dire que j'aimerais beaucoup apprendre car cela me serait très utile car je galère pas mal.
Existe-t-il des formations ou autres?
Le forum est un outil précieux mais quand on ne sait pas interprété les données par facile d'apprendre le langage....
En tout cas merci d'être là et de n'aider dans les requêtes. -
-
-
