VBA "défusionner" une colonne

Version imprimable

Bonjour,

J'ai besoin de dé-fusionner des cellules placées en colonnes, jusqu'à présent j'utilise le code suivant cependant ce dernier a pour effet de défusionner la feuille entière. Du coup ma macro dure 10-12secondes alors que j'aurais juste besoin de défusionner la colonne U ...
Est-il possible de "limiter" ce code à la colonne U ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub Miseenpage() Sheets("Planning").Activate Dim MergedCell As Range, FirstAddress As String, MergeAddress As String, MergeValue As Variant Application.FindFormat.MergeCells = True Do Set MergedCell = ActiveSheet.UsedRange.Find("", LookAt:=xlPart, SearchFormat:=True) If MergedCell Is Nothing Then Exit Do MergeValue = MergedCell.Value MergeAddress = MergedCell.MergeArea.Address MergedCell.MergeArea.UnMerge Range(MergeAddress).Value = MergeValue Loop Application.FindFormat.Clear end sub

Bonjour Admdg, bonjour le forum,

Peut-être comme ça :

Code:

1
2
3
4
5
6
7
8
9
Sub Miseenpage()
Dim PL As Range
Dim CEL As Range
 
Set PL = Application.Intersect(Sheets("Planning").UsedRange, Sheets("Planning").Columns("U"))
For Each CEL In PL
    If CEL.MergeCells = True Then CEL.MergeArea.UnMerge
Next CEL
End Sub

27/11/2014, 08h10
admdg

Bonjour Thautheme et merci de ta réponse !

J'ai essayé le code et en effet il marche cependant ce qui m'était utile dans le code cité dans mon 1er post c'est qu'en plus de défusionner mes cellules il me copiait la valeur dans chacune d'elle.
En fait sur une autre feuille j'ai des formules qui renvoient à des cellules précises, ces dernières étant parfois fusionnées je suis obligé de passé par là pour faire marcher mes fonctions, d'où l'intérêt pour moi de défusionner et remplir les cellules. ( J'aurais peut-être du le préciser ce n'était pas très clair :sm: )

En bon noob de VBA que je suis j'ai essayé de placer un

Citation:

.Columns("U")

par cis par là mais ça m'affiche des erreurs à chaque fois...

J'ai trouvé comment faire cependant cette solution me pose un problème "type 13 incompatibilité" sur mon code "'séparer les "MODE"" juste en dessous ... A ce que je comprends il y a un problème dans la déclaration de variables bien que je n'ai pas touché à ces dernières

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
'mise en page: defusioner et remplir les cases et replacer les titres

Sheets("Planning").Activate

Dim MergedCell As Range
Dim FirstAddress As String
Dim MergeAddress As String
Dim MergeValue As Variant

Application.FindFormat.MergeCells = True
Do
Set MergedCell = ActiveSheet.Range("U:U").Find("", LookAt:=xlPart, SearchFormat:=True)
If MergedCell Is Nothing Then Exit Do
MergeValue = MergedCell.Value
MergeAddress = MergedCell.MergeArea.Address
MergedCell.MergeArea.UnMerge
Range(MergeAddress).Value = MergeValue
Loop
Application.FindFormat.Clear


'séparer les "MODE"

Dim Lign As Long
Dim Plage As String
Dim I As Long, nbLignes As Long
nbLignes = Cells(Rows.Count, "D").End(xlUp).Row

Sheets("Expéditions").Select
 
    Lign = 22
    For Lign = 22 To 50
        If Cells(Lign, 5).Value <> Cells(Lign + 1, 5).Value Then
            Lign = Lign + 1
            Plage = Lign & ":" & Lign
            Rows(Plage).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    Next

Je vous ai mis la ligne surligné en gras, une idée ?

Bonjour Admdg, bonjour le forum,

J'avoue que si je t'ai proposé ce code hier c'est que j'ai rien compris au tien...
En revanche, je comprends la partie séparer "Mode". Tu déclares de type Long pour ensuite boucler de 22 à 50. Le type Byte serait plus approprié car moins gourmand en mémoire.
Je te propose ci-dessous ton code avec des commentaires :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Dim Lign As Byte 'byte est plus que suffisant vu que tu boucles de 22 à 50 'Dim Plage As String 'inutile voir modification du code Dim I As Long, nbLignes As Long 'la variable I n'apparaît pas dans le code ? nbLignes = Cells(Rows.Count, "D").End(xlUp).Row 'à quoi sert cette ligne et à quel onglet se rapporte-t-elle ? With Sheets("Expéditions") Lign = 22 'inutile For Lign = 22 To 50 If .Cells(Lign, 5).Value <> .Cells(Lign + 1, 5).Value Then Lign = Lign + 1 'Plage = Lign & ":" & Lign 'Rows(Plage).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove .Rows(Lign).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove End If Next End With

1 pièce(s) jointe(s)

Je vous avoue également que je n'y comprends pas tout non plus :oops: , enfaite l’intérêt de

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sheets("Planning").Activate
 
Dim MergedCell As Range
Dim FirstAddress As String
Dim MergeAddress As String
Dim MergeValue As Variant
 
Application.FindFormat.MergeCells = True
Do
Set MergedCell = ActiveSheet.Range("U:U").Find("", LookAt:=xlPart, SearchFormat:=True)
If MergedCell Is Nothing Then Exit Do
MergeValue = MergedCell.Value
MergeAddress = MergedCell.MergeArea.Address
MergedCell.MergeArea.UnMerge
Range(MergeAddress).Value = MergeValue
Loop
Application.FindFormat.Clear

était d'obtenir quelque chose comme ça Pièce jointe 162423 pour la colonne U uniquement

27/11/2014, 13h14
Thautheme

Bonjour Admdg, bonjour le forum,

C'est comme Djizeus ! Sauf qu'au lieu du pain, là, c'est la multiplication des vélos et des avions...
27/11/2014, 14h24
admdg

et des maux de tête VBA :piou:
27/11/2014, 14h27
SfJ5Rpw8
Citation:
...

Code:

1 2 3 4 5 ... For Lign = 22 To 50 If .Cells(Lign, 5).Value <> .Cells(Lign + 1, 5).Value Then Lign = Lign + 1 ...
Bonjour,
je n'ais pas regardé le reste du code ni qui l'as écris ... mais dans une boucle FOR il faut laisser la gestion de l'index (ici Lign) à l'instruction FOR .. éviter de rajouter une ligne telle que : Lign = Lign + 1
27/11/2014, 14h34
admdg

Bonjour Bbil,
Oui mais c'est inévitable pour traduire l'insertion de ligne avec la boucle FOR non ?

Un proposition générique pour une seule colonne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub UnmergeAndFill(ByVal Plage As Range)
Dim c As Range
Dim N As Long
 
For Each c In Plage
    If c.MergeCells Then
        N = c.MergeArea.Rows.Count
        c.UnMerge
        c.Resize(N) = c.Value
    End If
Next c
End Sub

On l'appelle pour ton cas (à adapter)

Code:

1
2
3
4
Sub Test()
 
UnmergeAndFill Worksheets("Planning").Range("U2:U2000") 'A adapter
End Sub