Discussion :

[Bib00]

Bonjour,

Débutant en vba, je bloque sur un une partie de mon code qui fonctionne mal et qui est surement améliorable. Pour mieux comprendre mon problème, vous référer au fichier excel joint.

Je dois fusionner toutes les cellules qui commencent par "SG" avec les cellules vides qui suivent. Selon les "SG", le nombre de cellule à fusionner est aléatoire.

Ma boucle fonctionne, mais met beaucoup de temps à s'executer (elle tourne assez longtemps dans chaque groupe de cellules fusionnées) , j'ai surement raté quelque chose.

Voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Macro1()
 
lastRow = ActiveSheet.Cells(65536, 1).End(xlUp).Row
 
    For i = 1 To lastRow
        If Cells(i, 1).Value Like "SG*" Then Range(Cells(i, 1), Cells(i, 1).End(xlDown).Offset(-1, 0)).Select
 
 
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
Next
 
 
 
End Sub

Merci de votre aide !!

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Fusion()
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    For Each c In .Range("A:A").SpecialCells(xlCellTypeConstants)
        If Left(c.Value, 2) = "SG" Then
            With .Range(c, c.End(xlDown).Offset(-1))
                .Merge
                .VerticalAlignment = xlTop
            End With
        End If
    Next c
End With
End Sub

Code n'est pas général et fonctionne sous les 2 conditions
- Colonne A non vide
- Au moins une cellule vide entre 2 valeurs SG-xx et Total SG-xx

[Fred.dz]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
 
Dim i As Integer
 
Dim premligneSG As Long
Dim dernligneSG As Long
 
Dim dernligne As Long
 
 
dernligne = 1
 
While Cells(dernligne, 1) <> "Total général"
    dernligne = dernligne + 1
Wend
 
For i = 1 To dernligne
    If Cells(i, 1) Like "SG*" Then
        premligneSG = i
        dernligneSG = premligneSG
        While Cells(dernligneSG + 1, 1) = ""
            dernligneSG = dernligneSG + 1
        Wend
        Range(Cells(premligneSG, 1), Cells(dernligneSG, 1)).MergeCells = True
        i = dernligneSG
    End If
Next i
 
End Sub

[Bib00]

Ca marche très bien
Merci beaucoup !!