Fusion automatique cellule en VBA

[Tensfoc]

Je suis (toujours) débutant en VBA.
J'ai une base de données comportant X lignes et Y colonnes

Dans une de mes colonnes (par exemple la colonne B) j'ai de temps en temps des données qui se répètent sur deux à 10 lignes (genre plusieurs commandes pour un même client).

Je voudrais savoir si il ya une possibilité de demander à l'aide d'une macro VBA d'automatiser la fusion des cellules identiques . Cette fusion ne doit s'effectuer que sur la colonne concernée.

Merci pour vos propositions.

 

[BOISGONTIER]

Re : Fusion automatique cellule en VBA

Bonjour,


Exemples:
http://boisgontierjacques.free.fr/fichiers/Cellules/MergeUnMerge2.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/MergeUnMerge.xls

JB
Formation Excel VBA JB

 

[job75]

Re : Fusion automatique cellule en VBA

Bonjour Tensfoc, JB,

Puisque je l'ai écrite, voici une solution :

Sub FusionCellules()
Dim i As Long, j As Long
Application.DisplayAlerts = False
For i = 1 To Range("B65536").End(xlUp).Row
j = 1
While Cells(i + j, 2) = Cells(i, 2)
Range(Cells(i, 2), Cells(i + j, 2)).MergeCells = True
j = j + 1
Wend
i = i + j - 1
Next
Application.DisplayAlerts = True
End Sub

Edit : désolé j'avais oublié j = j + 1... et le -1...!!

A+

 

[Tensfoc]

Re : Fusion automatique cellule en VBA

Trop cool cela marche nickel !
Une seule amélioration possible cette boucle ne fonctionne que sur 2 lignes identiques or j'ai souvent les mêmes cellules sur plus de 2 lignes.

Merci d'avance

 

[job75]

Re : Fusion automatique cellule en VBA

Re,

J'avais fait une erreur. Voyez l'Edit de mon post précédent et prenez la dernière version de la macro.

A+

 

[Tensfoc]

Re : Fusion automatique cellule en VBA

Impeccable cela marche nickel avec la modification.
J'ai même poussé le vice à rajouter des lignes sur d'autres colonnes en se basant sur le même test de ma colonne C. Ce n'est peut-être pas très propre mais cela marche nickel. Pas impossible que je revienne vers toi plus tard pour un développement complémentaire (on peut essayer de compliquer un peu l'affaire

Dim i As Long, j As Long
Application.DisplayAlerts = False
For i = 1 To Range("C65536").End(xlUp).Row
j = 1
While Cells(i + j, 3) = Cells(i, 3)
Range(Cells(i, 1), Cells(i + j, 1)).MergeCells = True
Range(Cells(i, 2), Cells(i + j, 2)).MergeCells = True
Range(Cells(i, 3), Cells(i + j, 3)).MergeCells = True
Range(Cells(i, 4), Cells(i + j, 4)).MergeCells = True
Range(Cells(i, 5), Cells(i + j, 5)).MergeCells = True
Range(Cells(i, 6), Cells(i + j, 6)).MergeCells = True
Range(Cells(i, 7), Cells(i + j, 7)).MergeCells = True
Range(Cells(i, 8), Cells(i + j, 8)).MergeCells = True
j = j + 1
Wend
i = i + j - 1
Next
Application.DisplayAlerts = True

 

[Tensfoc]

Re : Fusion automatique cellule en VBA

Un peu plus compliqué maintenant. Le résultat de la formule plus haut marche très bien.
Dans ma base de données je voudrais fusionner d'autres cellules sur la colonne selon plussieurs critères : seulement si les cellules sont identiques avec celle de la ligne précédente dasn deux colonnes à la fois.

Cela donnerait comme données

a d c v k l m
f d g l k u i
z d p q v x o
a r k h k d e

Les deux cellules rouges sont à fusionner car identiques à la fois sur la deuxième colonne et la 5 ème colonne.
Je suppose que je peux m'appuyer sur la code précédent qui fonction mais je ne sais comment intégrer une nouvelle contrainte.

Merci de m'aider ou de me demander de préciser ma questioon peut-être pas clair.

 

[job75]

Re : Fusion automatique cellule en VBA

Bonsoir Tensfoc,

Les deux cellules rouges sont à fusionner car identiques à la fois sur la deuxième colonne et la 5 ème colonne.

Merci de préciser :

- s'il faut tester uniquement les 2ème (B) et 5ème (E) colonnes (j'espère !)

- si les fusions ne concernent que la 5ème (E)

- si 2 cellules vides sont considérées comme identiques pour la fusion.

A+

 

[Tensfoc]

Re : Fusion automatique cellule en VBA

Bonsoir Tensfoc,



Merci de préciser :

- s'il faut tester uniquement les 2ème (B) et 5ème (E) colonnes (j'espère !)

- si les fusions ne concernent que la 5ème (E)

- si 2 cellules vides sont considérées comme identiques pour la fusion.

A+

Normalement pas de cellule vide dans ce tableau
Etape de fusion : je dois fusionner la colonne B en fonction des répétitions uniquement sur cette colonne et je dois fusionner les cellule de la colonne E si elles sont identiques et si en plus les deux cellules (ou plus) de la colonne B sont identiques également.
Pour illustrer : j'ai des propriétaires en colonne B que je fusionne si ils sont identiques et des locataires en colonne E. Je ne fusionne les locataires que si ils sont locataires de plusieurs biens sur un même propriétaire (colonne B)

En espèrant être plus clair.

Tensfoc

 

[job75]

Re : Fusion automatique cellule en VBA

Bonjour Tensfoc,

Je n'ai pas testé mais la macro suivante doit fonctionner. J'ai imbriqué une 2ème boucle For...Next pour la colonne E :

Sub FusionCellules()
Dim i As Long, j As Long, h As Long, k As Long
Application.DisplayAlerts = False
For i = 1 To Range("B65536").End(xlUp).Row 'étude colonne B
  j = 1
  While Cells(i + j, 2) = Cells(i, 2)
    Range(Cells(i, 2), Cells(i + j, 2)).MergeCells = True
    j = j + 1
  Wend
  For h = i To i + j - 1 'étude colonne E
    k = 1
    While Cells(h + k, 5) = Cells(h, 5)
      Range(Cells(h, 5), Cells(h + k, 5)).MergeCells = True
      k = k + 1
    Wend
    h = h + k - 1
  Next h
  i = i + j - 1
Next i
Application.DisplayAlerts = True
End Sub

Edit : grossière erreur ! Je remplace For h = i To j - 1 par For h = i To i + j - 1

A+

 

[Tensfoc]

Re : Fusion automatique cellule en VBA

Sub FusionCellules()
Dim i As Long, j As Long, h As Long, k As Long
Application.DisplayAlerts = False
For i = 1 To Range("C65536").End(xlUp).Row 'étude colonne C
j = 1
While Cells(i + j, 3) = Cells(i, 3)
Range(Cells(i, 3), Cells(i + j, 3)).MergeCells = True
j = j + 1
Wend
For h = i To j - 1 'étude colonne O
k = 1
While Cells(h + k, 15) = Cells(h, 15)
Range(Cells(h, 15), Cells(h + k, 15)).MergeCells = True
k = k + 1
Wend
h = h + k - 1
Next h
i = i + j - 1
Next i
Application.DisplayAlerts = True
End Sub

J'ai adapté avec les colonnes nécessaires.
Cela marche bien pour les premières celules de la colonne 15 mais cela ne s'incrémente pas sur les suivantes il doit manquer un ordre en +1 pour la colonne O (15) mais je n'arrive pas à trouver où.
Je te mets un exemple plus clair de format de données pour que tu vois si j'ai bien été clair (les cellules à fusionner sont de même couleur:

Colonne C Colonne 0
A 1
A 1
A 2
B 2
B 1
B 3
C 3

 

[job75]

Re : Fusion automatique cellule en VBA

Re,

Ouh là, grossière erreur ! Je remplace For h = i To j - 1 par For h = i To i + j - 1. Il faudrait toujours tester...

A+

 

[Tensfoc]

Re : Fusion automatique cellule en VBA

Cela marche bien pour la colonne O sur l'ensemble du tableau. Toutefois la fusion sur la colonne O se fait indépendemment de cellules identiques sur la colonne C. Dans l'exemple deux post plus haut, la macro fusionne la ligne 3 et 4 de la collone O alors que les données en colonne C ne sont pas identiques. Il y a-t-il moyen de remédier à ce problème ? Ne faut-il pas rajouter une deuxième condition lors de l'action sur la colonne O du même genre que
While Cells(h + k, 15) = Cells(h, 15) "ET" Cells (h+k, 3) = Cells(h,3) ou qqchose dans ce genre ?

 

[job75]

Re : Fusion automatique cellule en VBA

Re,

En fait on peut écrire plus simplement j et k :

Sub FusionCellules()
Dim i As Long, j As Long, h As Long, k As Long
Application.DisplayAlerts = False
For i = 1 To Range("B65536").End(xlUp).Row 'étude colonne B
  j = i + 1
  While Cells(j, 2) = Cells(i, 2)
    Range(Cells(i, 2), Cells(j, 2)).MergeCells = True
    j = j + 1
  Wend
  For h = i To j - 1 'étude colonne E
    k = h + 1
    While Cells(k, 5) = Cells(h, 5)
      Range(Cells(h, 5), Cells(k, 5)).MergeCells = True
      k = k + 1
    Wend
    h = k - 1
  Next h
  i = j - 1
Next i
Application.DisplayAlerts = True
End Sub

A+

 

[Tensfoc]

Re : Fusion automatique cellule en VBA

C'est en effet plus simple mais cela ne règle pas le problème de la double condition sur le While.
Existe-t-il une solution ?