[Toutes versions] Selectionner Cellules - Les fusionner et passer aux suivantes [Résolu]

[Roums]

Bon j'ai l'impression de partir dans un truc trop compliqué... ça peut marcher, mais vu que je m'acharne dessus, je dois manquer de lucidité, alors j'en profite pour voir si quelqu'un n'aurait pas une meilleure idée.

J'ai une colonne comme ceci :

Champ1
Champ2
Champ2
Champ3
Champ3
Champ4
Champ5
Champ5
Champ5
Champ5
.....

Je veux fusionner les cases ayant un champ identique avec, si possible :
le fait que cela marche si j'ajoute/change des champs, le fait que cela marche si la liste s'agrandit.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Fusion()
 
Dim ligne As Integer
Dim blop As Integer
Application.DisplayAlerts = False
 
ligne = 12
 
 
If Range("A" & ligne & "").Value <> Range("A" & ligne & "").Offset(-1).Value Then
blop = ligne
Do Until Range("A" & ligne & "").Value = Range("A" & ligne & "").Offset(-1).Value
If Range("A" & ligne & "").Offset(1).Value = Range("A" & blop & "").Value Then
Range(Range("A" & blop & ""), Range("A" & ligne & "").Offset(1)).Select
With Selection
        .HorizontalAlignment = xlLeft
         .VerticalAlignment = xlCenter
         .WrapText = False
         .Orientation = 0
         .AddIndent = False
         .ShrinkToFit = True
         .MergeCells = True
End With
'blop = ligne + 1
End If
'Selection.Merge
ligne = ligne + 1
Loop
End If
Application.DisplayAlerts = True
 
End Sub

Voilà mon usine à gaz !

Sauf qu'actuellement ça ne marche (un peu) que si je démarre au milieu de la colonne (ligne 12), si je commence à la ligne 6, ça ne fait rien (normal surement, car c'est un champ unique).
Et si je tombe sur le Champ 5, cela ne me prend que 3 cases au lieu des 4 qui le contiennent.
Ensuite j'ai du mal à passer aux cellules suivantes, une fois la fusion effectuée.

Je vais mettre ça de côté un peu, le temps que ça retombe et que je retrouve un peu de lucidité déjà.

Merci pour ceux qui auraient une idée.

PS: j'ai déjà fait quelque chose du genre qui marchait mais c'était plus simple car il y avait des cases vides entre chaque champ différent, et je n'avais qu'à faire des xldown, sélectionner, fusionner. Là ça m'embête un peu plus.

[mercatog]

Une proposition
les données commencent en A1 jusqu'à Axx

Code :

1
2
3
4
5
6
7
sub MergeCells()
dim i as long
application.displayalerts = false
for i = cells(rows.count, 1).end(xlup).row to 2 step -1
    if range("a" & i - 1).value = range("a" & i).value then range("a" & i - 1 & ":a" & i).aerge
next i
end sub

les données de la colonne A doivent être triées bien sûr

[Roums]

La colonne a est effectivement triée, du coup ça semble marcher parfaitement... et ça semble bien plus simple que ce sur quoi je m'engageais... je n'utilise jamais les Rows.Count mais ça semble bien utile dans certains cas.

Merci beaucoup mercatog!