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.

 

[job75]

Re : Fusion automatique cellule en VBA

Re,

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

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]

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]

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 :

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]

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]

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]

Re : Fusion automatique cellule en VBA

Bonjour Guiiggs et bienvenu,

Voir un essai dans le fichier joint.

 

[Guiiggs]

Re : Fusion automatique cellule en VBA

Salut,

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

 

[spudy]

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