Discussion :

[-vanessa-]

Bonjour à tous

Est-il possible de fusionner automatiquement deux cellules en fonction d'un résultat ?! (soit grâce à une macro ou soit grâce à une fonction conditionnelle)

Exemple:
Si A1 = "accepter" alors B1, C1, D1 et E1 se fusionnent en supprimant les informations contenus dans chacune de ces cellules (en effet, B1, C1, D1 et E1 contiennent déjà des valeurs)

Merci
Bonne journée

[francky74]

Bonjour,

Essaies ceci :

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
 
Sub Macro1()
'
' Macro1 Macro
'
 
'
If VariableA1 = "accepter" then
    Range("B1:E1").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
    Selection.ClearContents
End If
 
End Sub

[MarcelG]

Bonjour,

Les Select qui ne servent à rien! Si ce n'est qu'à alourdir le code.

A adpter

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
Public Sub ESSAI2()
 
Dim c As Range
 
For Each c In Range("A15:A17")
        With c
                If .Value = "accepter" Then
                         With Range(.Offset(0, 1), .Offset(0, 4))
                                 .ClearContents
                                .Merge
                        End With
                End If
        End With
Next c
 
End Sub

[mercatog]

Bonjour
Une autre proposition en utilisant un filtre automatique (pour éviter de boucler sur chaque ligne)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1") 'Adapte le nom de ta feuille
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:="accepter"
    If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Application.DisplayAlerts = False
        .Range("B2:E" & LastLig).SpecialCells(xlCellTypeVisible).Merge False
        Application.DisplayAlerts = True
    End If
    .AutoFilterMode = False
End With

[MarcelG]

Bonjour mercatog,

D'accord avec ta méthode.

Mais, sauf erreur de ma part, elle ne fusionne pas les colonnes avoisinantes et n'efface pas leur contenu.

[mercatog]

Bonjour Marcel

Mais, sauf erreur de ma part, elle ne fusionne pas les colonnes avoisinantes et n'efface pas leur contenu.

je n'ai pas compris ta remarque.
Le code proposé fusionne les cellules de B à E en gardant la valeur de B (pour chaque ligne où se trouve "accepter" en colonne A)

Sinon, la méthode est là (se passer des boucles quand on a une méthode directe et ça reste un choix personnel)

Pour fusionner et supprimer les contenu de B à E, c'est plus facile

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
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        'Adapte le nom de ta feuille
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:="accepter"
    If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        With .Range("B2:E" & LastLig).SpecialCells(xlCellTypeVisible)
            .ClearContents
            .Merge False
        End With
    End If
    .AutoFilterMode = False
End With

[Orhleil]

Je suis d'accord avec Francky ça devrait fonctionner comme ça.
JUste, moi je mettrais un Unmerge au début :

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
Sub Macro1()
'
' Macro1 Macro
'
 
'
If VariableA1 = "accepter" then
    Range("B1:E1").Select
    Selection.Unmerge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.ClearContents
End If
 
End Sub

Juste au cas où y'aurait une fusion foireuse à un moment, tu défais le truc et tu le relances comme ça tu es sûr qu'il n'y aura pas de bug à ce niveau là.
C'est peut-être un cas impossible pour toi j'en sais rien, je signale juste que ça peut t'éviter des embrouilles =p

[MarcelG]

Et moi, je ne suis pas d'accord avec l'utilisation de la méthode

Code :

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

Select

à tout va!!!

A la rigueur, comme tu l'as justement souligné, tu peux désactiver une propriété

Code :

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

Merge

éventuelle.

Mais de cette façon.

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
Public Sub ESSAI2()
 
Dim c As Range
 
For Each c In Range("A15:A17")
        With c
                If .Value = "accepter" Then
                         With Range(.Offset(0, 1), .Offset(0, 4))
                                 .MergeCells = False
                                 .ClearContents
                                .Merge
                        End With
                End If
        End With
Next c
 
End Sub

Quant à l'enregistreur, je suis le premier à reconnaître son utilité. Mais une fois utilisé, il convient de l'épurer au maximum.

On s'en rend vite compte avec la méthode

Code :

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

PageSetUp

(mise en page)