XL 2016 Fusionner et centrer des cellules

Alex6942

XLDnaute Nouveau
Bonjour,

Je cherche à fusionner et centrer des cellules d’une même colonne sur plusieurs lignes en fonction de la valeur des cellules en colonne à partir de la ligne 7.

Par exemple, si [I14] = [I15] alors fusionner/centrer les deux cellules en colonne ainsi que en D, E J ; K et L de ces mêmes lignes. (Toujours en fonction de la valeur I)
Si [I28] = [I29] = [I30] alors .... identique que au dessus..

La plage de X lignes contient des lignes filtrées, qu’il ne faut pas prendre en compte.
Idem que certaines colonnes qui sont masqués (F, G , H)

J’ai essayé à partir du code suivant que j'ai essayé d'adapter.

VB:
Sub Test_fusion()


     Nettoyer Range("I:J"), 1 ' Partie 1
     Nettoyer Range("K:L"), 1 ' Partie 2
     Fusionne Range("I7:L200"), 2, 1
    
End Sub
Sub Nettoyer(Plage As Range, Colonne_Ref As Integer)
Dim UsedRow As Integer
Dim R As Range


    With Plage
        UsedRow = ActiveSheet.UsedRange.Rows.Count
        Set R = .Columns(Colonne_Ref).Find("*", .Rows(UsedRow).Cells(1), , , , xlPrevious)
        Select Case True
        Case R Is Nothing:  ' rien
        Case R.Row + 1 = UsedRow: 'rien
        Case Else
            Lastcol = Plage.Column + .Columns.Count - 1
            Range(R.Offset(1), Cells(UsedRow, Lastcol)).Delete xlShiftUp
        End Select
    End With


End Sub
Sub Fusionne(Plage As Range, ParamArray Col() As Variant)
Dim Row As Integer, i As Integer
Dim Dc As String, Df As String


Application.DisplayAlerts = False


    With Plage
        Lastrow = .Rows.Count + Plage.Row
        Lastcol = .Columns.Count
        For i = 0 To UBound(Col)
            Dc = vbNullString
            For Row = 7 To Lastrow
                Debug.Print .Cells(Row, Col(i))
                If .Cells(Row, Col(i)) <> .Cells(Row - 1, Col(i)) Then
                    If Dc <> vbNullString And Not .Cells(Row, Col(i)).MergeCells Then
                        With Range(Dc, Df)
                            .Merge
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlCenter
                        End With
                    End If
                    Dc = .Cells(Row, Col(i)).Address
                End If
                Df = .Cells(Row, Col(i)).Address
             Next
         Next
         .Cells(1, 1).Activate
    End With


End Sub
Sub show_Color()
    Debug.Print ActiveCell.Interior.Color
End Sub

Cependant le résultat obtenu ne me convient que partiellement.
La fusion ne dépend pas des valeurs en I mais dépend des valeurs par ligne et colonne. et ne s'applique pas a toutes les plages.

1625495554105.png


Si quelqu'un à une solution ..

Cordialement,
 

Alex6942

XLDnaute Nouveau
Bonjour

La fusion de cellules entraîne tout un tas de problèmes notamment pour les tris, filtres, copies...

La répétition sur chahque ligne et le masquage de celle-ci par MFC est nettement préférable

Bonjour Chris,

Merci pour ton retour, cependant une fois ces cellules fusionnées et centrées, le fichier ne sert que de consultation. Le but étant d'harmoniser/fluidifier la mise en page pour faciliter la lecture/compréhension du tableau.


Cordialement,
 

Discussions similaires

Haut Bas