fusion de cellules identiques Résolu

Question

Bonjour

J'ai trier des données et j'ai des répétitions de lignes (3fois la mêm valeur, puis 2 fois une autres etc). j'aimerai pouvoir fusionner les cellules automatiquement pour plus de clarté de lecture mais là je bloque...

merci

gbinforme · Accepted Answer

bonjour


Si tu veux une macro qui fusionne tous les doubles verticaux avec des paramètres de plage et sans message de confirmation, tu peux essayer ceci :
Sub fusion_doubles_vertical()
Dim l As Long       ' ligne
Dim d As Long       ' doubles
Dim c As Integer    ' colonne
Const minl = 1      ' début ligne
Const maxl = 6      ' fin ligne
Const minc = 1      ' début colonne
Const maxc = 2      ' fin colonne
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For c = minc To maxc
    For l = minl To maxl
        For d = l + 1 To maxl
            If (Cells(l, c) <> Cells(d, c)) Then Exit For
        Next d
        If d > l + 1 Then
            With Cells(l, c).Resize(d - l, 1)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
        End If
    Next l
Next c
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

ReM · Answer

J'ai oublié de préciser : je suis sous excel 2000 et je cherche une macro VBA qui va bien...

Kobaya · Answer

salut,que veux-tu faire exactement? supprimer les lignes en doublons?

bgob · Answer

bonjour,
plus facile pour améliorer la lisibilité,
se mettre sur la deuxième ligne et dans la colonne où tu ne désires plus voir les doublons,
format, mise en forme conditionnelle,
la valeur de la cellule est égale =a1 (cellule précédente, en otant les dollars)
format, police, couleur blanc
copier, marquer les autres cellules et collage spécial format
espérant t'avoir aidé
a+

gbinforme · Answer

bonjourj'aimerai que les cellules comportant des données identiques soient fusionnées... pour cela , tu peux fusionner effectivement mais le comportement des cellules fusionnées est différent.je te propose plutôt de supprimer les lignes identiques avecla macro suivante à insérer dans la feuille avec ALT + F11puis executer  avec ALT + F8 puis executer.Public Sub sup_doubles()Dim col, ligFor lig = 0 To (Cells(65000, 1).End(xlUp).Row - 1)    If Range("a1").Offset(lig, 0).Value = Range("a1").Offset(lig + 1, 0).Value Then        For col = 0 To Range("a1").Offset(lig, 0).End(xlToRight).Column - 1            If Not Range("a1").Offset(lig, col).Value = Range("a1").Offset(lig + 1, col).Value Then Exit For        Next col        If col = Range("a1").Offset(lig, 0).End(xlToRight).Column Then            Range("a1").Offset(lig, 0).EntireRow.Delete        End If    End IfNext ligEnd Sub

Demongate · Answer

J'ai le même problème, j'aimerais que les cellules soient fusionnées.

La raison est que mes cellules sont très petites et on ne voit pas leur contenu.

En fusionnant les cellules identiques cela permettra alors de voir le contenu, car il n'y aura qu'une seule grosse cellule.

Si on supprime seulement les doublons, cela ne permet pas de voir ce qui est écrit dans la cellule car le contenu ne défile pas vers les cases vides verticalement.

Cela permet aussi de centrer l'information sur les plusieurs cases au lieu d'avoir l'info en haut ou en bas.

Merci pour l'aide.

gbinforme · Answer

bonjour

Cela permet aussi de centrer l'information sur les plusieurs cases 

Dans "format cellule" tu as la possibilité, sans fusionner, de centrer sur plusieurs colonnes.

Lorsque tu fusionnes sur plusieurs lignes, il ne faut pas oublier que le tri du tableau n'est pratiquement plus possible.

Demongate · Answer

oui, mais il n'y a pas centrer sur plusieurs lignes.

Allan · Answer

Salut ReM, 

J'ai eu a peu pres le meme probleme. 
Je voulais fusionner les valeurs des lignes ou la colonne est identique, tout en gardant les valeurs separees dans les autres colonnes. 
Par exemple: 
   A   B  C  D 
1 W  w  x  x 
2 W  w  x  x 
3 X   x   x  x 
4 Y   y   x  x 
5 Z   z   x  x 
6 Z   z   x  x 

Dans ce cas, je veux fusionner les doublons W et Z des colonnes A et B, tout en gardant les données des colonnes C et D tel quel. 

Je ne suis pas habitue a faire des macros, mais en trifouillant j'ai trouve la formule suivante, qui semble fonctionner: 

Sub fusion_2cell_vertical() 
Dim i As Integer 
Application.ScreenUpdating = False 
For i = 1 To 6 
If (Cells(i, 1) = Cells(i + 1, 1)) Then 
    Range(Cells(i, 1), Cells(i + 1, 1)).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 
    Range(Cells(i, 2), Cells(i + 1, 2)).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 
i = i - 1 
End If 
Next 
Application.ScreenUpdating = True 
End Sub

Un message previent qu'il gardera la valeur superieure gauche pour la fusion. Il faut cliquer sur OK a chaque fois. 
Attention! 
Il faut adapter la formule au nombre de lignes de ton tableau (dans ma formule, le "6" a la quatrieme ligne, pour un tableau de 6 lignes). 
Il faut aussi adapter les colonnes que tu veux fusionner. Dans mon exemple, ce sont les colonnes "1" et "2" (pour A et B) --> Cells(i, 1), Cells(i, 2) 

Le probleme, c'est que je ne crois que ca fonctionne pour fusionner un nombre variable de lignes. Par exemple, une fois 2 lignes, un fois 3 lignes... Dans mon cas, je fusionne toujours les lignes par 2. 

C'est un peu confus. 
Si ca a pu aider...

gbinforme · Answer

bonjour

Tu remplaces les codes paramètres
Const maxl = 6      ' fin ligne
Const minc = 1      ' début colonne
Const maxc = 2      ' fin colonne

par

Dim maxl as long
maxl = usedrange.rows.count      ' fin ligne
Const minc = 1      ' début colonne
Dim maxc as integer
maxc = usedrange.columns.count       ' fin colonne

Ainsi ta macro prend en compte toutes tes lignes et toutes tes colonnes.

Je t'ai fais cette modification pour répondre à ton souhait mais comme je te l'ai déjà dit, le fait de créer des cellules fusionnées va te créer des problèmes lors de l'utilisation de ton tableau par d'autres macros car la fusion perturbe ensuite l'adressage des cellules.

Allan · Answer

Gbinforme,

Je n'ai pas du bien comprendre comment remplacer les codes parametres parce que ca ne fonctionne plus, d'autant que je ne veux pas appliquer cette macro a toutes les colonnes (mais OK pour toutes les lignes).

Par contre, en adaptant ces codes parametres a la taille de mon tableau (de telle ligne a telle ligne et de telle colonne a telle colonne), ca marche au poil !
Donc merci beaucoup gbinforme pour cette macro bien pratique.

Etiennedobrasil20 · Answer

Bonjour,

Merci gbinforme pour ce code.
J'ai essayé de l'adapter pour mon cas de figure: je voudrais fusionner et centrer 2 cellules identiques horizontalement.
J'ai tenté d'adapter le code de gbinforme à mon cas de figure, sachant que mon tableau fait 100 lignes et 100 colonnes (voir ci-dessous). Mais quand je lance la macro, elle tourne sans fin dans le vide, sans jamais donner de résultat. Savez-vous si quelque chose ne va pas avec mon code?
Merci d'avance.

Dim l As Long       ' ligne
Dim d As Long       ' doubles
Dim c As Integer    ' colonne
Const minl = 1      ' début ligne

Dim maxl as long
maxl = 100      
Const minc = 1      
Dim maxc as integer
maxc = 100       

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For l = minl To maxl
    For c = minc To maxc
        For d = c + 1 To maxc
            If (Cells(l, c) <> Cells(l, d)) Then Exit For
        Next d
        If d > c + 1 Then
            With Cells(l, c).Resize(l, d - c)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
        End If
    Next c
Next l
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Fusion de cellules identiques

12 réponses

Discussions similaires

Newsletters