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 :

vap1

Pour se faire, j'ai utilisé une boucle for de 1 à 365 pour avoir mes 365 jours, j'obtiens quelque chose comme ci-dessous :

vap2

(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)

image

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 Sub

Merci 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 :)

Rechercher des sujets similaires à "fusion conditions vba"