Fusion de cellule si elles sont identiques

[malvin]

Bonjour,
J'ai bien parcouru les discussions, on y trouve bp de choses interressantes, mais je n'ai pas trouvé de réponse à mon problème.
Je cherche une macro qui, apres sélection d'un ensemble de cellules par l'utilisateur (action manuelle), puisse fusionner celles qui sont identiques. Plus précisemment, je cherche une fusion horizontal.
Si vous pouvez m'apporter aide et explications; merci bp

Par exmple, si ma zone sélectionnée par l'utilisateur contient :
1 2 3 3 4 5 6 6 6 6 7 8 9
1 1 2 3 4 5 6 7 7 7 7 8 8

Le résultat sera les 2 lignes suivantes :
1 2 3 4 5 6 7 8 9
1 2 3 4 5 6 7 8

 

[Gorfael]

Re : Fusion de cellule si elles sont identiques

Salut malvin et le forum
Macro sans sécurité :

Sub test()
Dim X As Long, Plage As Range
Set Plage = Selection
Application.DisplayAlerts = False
For X = Plage.Cells.Count To 2 Step -1
    If Plage.Cells(X).Row = Plage.Cells(X - 1).Row And _
       Plage.Cells(X) = Plage.Cells(X - 1) Then _
       Range(Plage.Cells(X - 1), Plage.Cells(X)).Merge
Next X
Application.DisplayAlerts = True
End Sub

Elle fusionne les cellules voisines ayant la même valeur sur la même ligne.
A+

 

[job75]

Re : Fusion de cellule si elles sont identiques

Bonjour malvin, bienvenue sur XLD, salut Gorfael,

Une solution voisine :

Sub FusionIdentique()
Dim cel As Range
Application.DisplayAlerts = False
For Each cel In Selection
  If cel.Column > 1 Then
    If Not Intersect(cel.Offset(, -1), Selection) Is Nothing Then
      If cel = cel.Offset(, -1).MergeArea.Cells(1, 1) Then _
        Range(cel, cel.Offset(, -1).MergeArea).Merge
    End If
  End If
Next
End Sub

A+

 

[malvin]

Re : Fusion de cellule si elles sont identiques

Hello !
vous etes vraiment trop forts sur ce site,
merci bp pour cette efficacité et cette réponse exacte !
A bientot

 

[JHA]

Re : Fusion de cellule si elles sont identiques

Bonjour Malvin ,le forum,

Peut être une solution par formule,

JHA

 

[akcyd]

Re : Fusion de cellule si elles sont identiques

Bonjour,

J'ai remarqué que les macros marchent mais seulement pour les lignes. Pourriez-vous traduire ces macros pour qu'elles marchent sur une colonne ?

 

[Victor21]

Re : Fusion de cellule si elles sont identiques

Bonjour, akcyd.

En reprenant le code de job75 , par exemple,

Sub FusionIdentique()
 Dim cel As Range
 Application.DisplayAlerts = False
 For Each cel In Selection
   If cel.Column > 1 Then
     If Not Intersect(cel.Offset(, -1), Selection) Is Nothing Then
       If cel = cel.Offset(, -1).MergeArea.Cells(1, 1) Then _
         Range(cel, cel.Offset(, -1).MergeArea).Merge
     End If
   End If
 Next
 End Sub

et en remplaçant les références aux lignes par les références aux colonnes, ça devrait donner quelque chose comme ça :

Sub FusionIdentique()
 Dim cel As Range
 Application.DisplayAlerts = False
 For Each cel In Selection
   If cel.Row > 1 Then
     If Not Intersect(cel.Offset(-1, 0), Selection) Is Nothing Then
       If cel = cel.Offset(-1, 0).MergeArea.Cells(1, 1) Then _
         Range(cel, cel.Offset(-1, 0).MergeArea).Merge
     End If
   End If
 Next
 End Sub

 

[akcyd]

Re : Fusion de cellule si elles sont identiques

Génialissime ! Un grand merci !

 

[Victor21]

Re : Fusion de cellule si elles sont identiques

Re,

Génialissime ! Un grand merci !

Correction :

Génialissime ! Un grand merci à job75 !

 

[Thiblanchamp]

Re : Fusion de cellule si elles sont identiques

Bonjour,
Je déterre le sujet car il m'intéresse grandement !
Quel serait le code qui correspondrait à la même manipulation que la dernière citée (fusion si cellule d'une même colonne indentique) mais cette fois-ci sur une selection donnée et figée ( plage (AO25:AO107)) de l'onglet "Cas 1". Le but étant aussi que la macro se déclenche automatiquement sans clic sur un bouton ou quoi que se soit.
Je commence seulement à prendre connaissance des procédures VBA, je suis dans le néant ..... ^^

Merci pour votre aide !

Cdlt,
Thibault