Fusion cellules sous conditions VBA
Bonjour à tous :
J'essaie d'automatiser un fichier excel de telle sorte à obtenir un calendrier comme montré ci dessous, qui démarre à la date du jour et qui s'arrête un an plus tard :
Pour se faire, j'ai utilisé une boucle for de 1 à 365 pour avoir mes 365 jours, j'obtiens quelque chose comme ci-dessous :
(La premiere ligne sont les dates entières, je la masquerai tout simplement ensuite).
Par contre la question est de fusionner ci dessus les cellules identiques, 2021, 2022 et les mois pour obtenir quelque chose comme dans la 1ere capture.
Le calendrier commence en colonne D, soit 4.
J'ai tenté ceci, pour les années premièrement :
Sub FUSION()
Application.DisplayAlerts = False
Dim c As Integer
For c = 4 To 369
If Cells(2, 4).Value = Cells(2, c + 1).Value Then
Range(Cells(2, 4), Cells(2, c + 1)).Merge
End If
Next
Voilà ce que ca donne : (j'ai masqué des colonnes pour voir la jonction 2021-2022)
Du coup la condition SI demande de comparer chaque date à celle inscrite en D2, ce qui fait que ca marche que pour 2021. Mais pour 2022 je ne peux pas fusionner
Savez vous comment je pourrai faire pour comparer plutot la valeur de chaque cellule par rapport à la valeur des cellules précédemment fusionnées et ainsi les fusionner de nouveau ou non?
Evidemment je veux faire pareil avec les mois.
Je ne sais pas si je suis clair.
Ce n'est pas le fond du projet mais nous devons nous baser sur un calendrier de ce type, ce qui me bloque pour le reste du projet.
Merci beaucoup, je reste dispo si vous avez besoins d'autres infos !
Antoine
Hello,
Je ferai comme ceci (Exemple sur des années en ligne 1 et jusque la colonne 5 ou "E"):
Sub merge_annee()
Dim j As Long, x As Long
Dim last_col As Long
Dim annee As Long
Dim rng_merge As Range
j = 1
last_col = 5
Application.DisplayAlerts = False
Do Until Cells(1, j) <= last_col
annee = Cells(1, j)
x = j
Do Until Cells(1, x) <> annee
x = x + 1
Loop
Set rng_merge = Range(Cells(1, j), Cells(1, x - 1))
With rng_merge
.Merge
.HorizontalAlignment = xlCenter
End With
j = x
Loop
Application.DisplayAlerts = True
End SubMerci beaucoup je n'avais pas vu ta réponse, j'ai trouvé un autre moyen de le faire entre-temps.
Mais je vais essayer ta méthode, ca semble plus opti :)