Fusion automatique cellule en VBA

Tensfoc · 25 Novembre 2008

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.

job75 · 28 Novembre 2008

Re : Fusion automatique cellule en VBA

Re,

En fait, il fallait diminuer de 1 les bornes supérieures des boucles For :

Code:

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 [COLOR="Red"]- 1[/COLOR] 'é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 - [COLOR="Red"]2[/COLOR] 'é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

On s'embrouille facilement avec les indices, c'est pour ça qu'il faut tester...

A+

Tensfoc · 28 Novembre 2008

Re : Fusion automatique cellule en VBA

On s'embrouille facilement avec les indices, c'est pour ça qu'il faut tester...

A+

En effet !😀
J'ai fait le test on approche de la solution mais je pense qu'il y a conflit entre les deux fusions ce qui amène des erreurs type décalage d'une ligne.
Je te mets le fichier source pour que tu vois le problème.

job75 · 28 Novembre 2008

Re : Fusion automatique cellule en VBA

Re,

Merci pour le fichier, j'avais testé mais pas assez ! Et j'ai eu du mal à voir d'où venait le problème, un peu vicieux quand même.

Il fallait limiter la 2ème boucle While par la condition supplémentaire k < j :

Code:

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 - 1 'é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 - 2 'étude colonne E
    k = h + 1
    While Cells(k, 5) = Cells(h, 5) And [COLOR="Red"]k < j[/COLOR]
      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

Il n'y a pas ce problème avec la 1ère boucle While puisque l'on fusionne toutes les cellules identiques.

A+

Tensfoc · 28 Novembre 2008

Re : Fusion automatique cellule en VBA

🙂🙂🙂🙂Impeccable cela marche nickel. La fusion des cellules a un peu déterioré mes mises en formes conditionnelles mais le résultat est top.
Pour le plaisir voici le code final adapté à mes colonnes et en fusionnant sur les colonnes voisines.

Merci bcp à toi.🙂🙂🙂🙂

Dim i As Long, j As Long, h As Long, k As Long
Application.DisplayAlerts = False 'désactive la boîte de dialogue de la fusion
'étude colonne C (3)(code propriété) pour fusion des propriétés
For i = 1 To Range("C65536").End(xlUp).Row - 1
j = i + 1
While Cells(j, 3) = Cells(i, 3)
'Fusion des colonnes se rapportant à la propriété
Range(Cells(i, 1), Cells(j, 1)).MergeCells = True
Range(Cells(i, 2), Cells(j, 2)).MergeCells = True
Range(Cells(i, 3), Cells(j, 3)).MergeCells = True
Range(Cells(i, 4), Cells(j, 4)).MergeCells = True
Range(Cells(i, 5), Cells(j, 5)).MergeCells = True
Range(Cells(i, 6), Cells(j, 6)).MergeCells = True
Range(Cells(i, 7), Cells(j, 7)).MergeCells = True
Range(Cells(i, 8), Cells(j, 8)).MergeCells = True
j = j + 1
Wend
'étude colonne E (15)(location) pour fusion des locations
For h = i To j - 2
k = h + 1
While Cells(k, 15) = Cells(h, 15) And k < j
'Fusion des colonnes se rapportant à la location et au terrier
Range(Cells(h, 13), Cells(k, 13)).MergeCells = True
Range(Cells(h, 14), Cells(k, 14)).MergeCells = True
Range(Cells(h, 15), Cells(k, 15)).MergeCells = True
Range(Cells(h, 16), Cells(k, 16)).MergeCells = True
Range(Cells(h, 17), Cells(k, 17)).MergeCells = True
Range(Cells(h, 18), Cells(k, 18)).MergeCells = True
Range(Cells(h, 19), Cells(k, 19)).MergeCells = True
Range(Cells(h, 20), Cells(k, 20)).MergeCells = True
k = k + 1
Wend
h = k - 1
Next h
i = j - 1
Next i
Application.DisplayAlerts = True 'réactive les boîtes de dialogue

Guiiggs · 4 Mai 2012

Re : Fusion automatique cellule en VBA

Bonjour,

Voilà je souhaite fusionner mes 6 premières colonnes comme présenté sur le tableau de droite svp.

J'ai déjà essayé plusieurs macros (personnels et publics) sans réussite.

Merci de m'aider

Guiiggs

mapomme · 5 Mai 2012

Re : Fusion automatique cellule en VBA

Bonjour Guiiggs et bienvenu,

Voir un essai dans le fichier joint.

Guiiggs · 10 Mai 2012

Re : Fusion automatique cellule en VBA

Salut,

Merci mapomme ton algorithme marche nikel !! Je n'avais pas pensé à faire ça nikel !!

spudy · 18 Novembre 2013

Re : Fusion automatique cellule en VBA

Bonjour job75,
je passe sur le forum et j'aimerai adapter ton super code à la colonne J de mon tableau mais sans succès
Tu aurai une idée?
Merci d'avance

Fusion automatique cellule en VBA

Tensfoc

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Tensfoc

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Tensfoc

XLDnaute Nouveau

Guiiggs

XLDnaute Nouveau

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Guiiggs

XLDnaute Nouveau

spudy

XLDnaute Nouveau

Discussions similaires

Fusion automatique cellule en VBA

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency