Bouger les mois par macro

[sonskriverez]

Bonsoir le forum,

Je dois par macro, modifier une liste d'actions à faire sur un mois donné et l'étaler sur l'année. J'ai besoin de votre aide sur l'ecriture d'une macro.
J'ai fais un exemple de l'origine et du résultat attendu.

Merci de votre aide

 

[jmd2]

Re : Bouger les mois par macro

Bonjour

En gros, tu divises le nombre de lignes par 8 (8=nombre de mois) et tu reportes autant de fois par mois réellement travaillés.

Pourquoi automatiser si tu ne dois faire une mise àjour qu'une fois/mois ?

 

[sonskriverez]

Re : Bouger les mois par macro

Bonjour Jmd2, bjr le forum

merci de ta réponse, mais cette opération doit être automatisée car répétée plusieurs fois sur des listes de longueur différentes.

Si je divise par 8 le nbr de ligne cela me donne le nbr de fois qu'un même mois doit s'inscrire en colonne , par ex: 45/8 = 5,62 arrondi à 6, comme en colonne B le premier mois est 04 il faut mettre en colonne C "4" et en D "avril" et le répéter 6 fois et ainsi de suite et en sautant le mois "08".

merci de ton aide

 

[Pierrot93]

Re : Bouger les mois par macro

Bonjour,

si j'ai bien compris... dans ton exemple, pour le mois de décembre, il n'y a que 3 lignes... regarde la macro ci dessous, si cela peut t 'aider :*

Option Explicit
Sub test()
Dim x As Integer, i As Byte, j As Byte, k As Byte
x = WorksheetFunction.RoundUp(Range("A3:A" & Range("A65536").End(xlUp).Row).Rows.Count / 8, 0)
k = 3
For i = 4 To 12
    For j = 1 To x
        Cells(k, 3).Value = i
        Cells(k, 4).Value = MonthName(i)
        Cells(k, 5).Value = Cells(k, 3).Value - Cells(k, 2).Value
        k = k + 1
    Next j
    If i = 7 Then i = 8
Next i
Range("E3:E" & Range("E65536").End(xlUp).Row).NumberFormat = "0.00"" mois"""
End Sub

bonne journée
@+

 

[Pierrot93]

Re : Bouger les mois par macro

Re

avec un test supplémentaire pour coller au nombre de lignes...

Option Explicit
Sub test()
Dim x As Integer, i As Byte, j As Byte, k As Byte
x = WorksheetFunction.RoundUp(Range("A3:A" & Range("A65536").End(xlUp).Row).Rows.Count / 8, 0)
k = 3
For i = 4 To 12
    For j = 1 To x
        Cells(k, 3).Value = i
        Cells(k, 4).Value = MonthName(i)
        Cells(k, 5).Value = Cells(k, 3).Value - Cells(k, 2).Value
        k = k + 1
        If k = Range("A3:A" & Range("A65536").End(xlUp).Row).Rows.Count - 3 Then Exit For
    Next j
    If i = 7 Then i = 8
Next i
Range("E3:E" & Range("E65536").End(xlUp).Row).NumberFormat = "0.00"" mois"""
End Sub

@+

 

[sonskriverez]

Re : Bouger les mois par macro

Bonjour Pierrot,

Merci de ton aide, j'ai modifier ton code pour prendre en compte le premier mois quelque soit celui-ci.

For i = Cells(k, 2).Value To 12

et cela fonctionne bien sur la liste de l'exemple, par contre j'ai fais un essais sur des listes de longueur différente et soit il manque des lignes ou soit il y en a de trop. Essaye en prenant que les 3 premieres lignes de l'exemple. Je n'arrive pas à modifier correctement la ligne de l'exit for pour que cela fonctionne.
Il manque juste ça

Merci de votre aide

 

[Pierrot93]

Re : Bouger les mois par macro

Re

oui, effectivement, regarde plutôt comme ceci :

Option Explicit
Sub test()
Dim x As Integer, y As Byte, i As Byte, j As Byte, k As Byte
y = Range("A3:A" & Range("A65536").End(xlUp).Row).Rows.Count
x = WorksheetFunction.RoundUp(y / 8, 0)
k = 3
For i = 4 To 12
    For j = 1 To x
        Cells(k, 3).Value = i
        Cells(k, 4).Value = MonthName(i)
        Cells(k, 5).Value = Cells(k, 3).Value - Cells(k, 2).Value
        k = k + 1
        If k = y + 3 Then GoTo fin
    Next j
    If i = 7 Then i = 8
Next i
fin:
Range("E3:E" & Range("E65536").End(xlUp).Row).NumberFormat = "0.00"" mois"""
End Sub

@+

 

[sonskriverez]

Re : Bouger les mois par macro

Bosoir Pierrot, bonsoir le forum

Toujours le même bug, il y a un depassement de 2 ou trois lignes selon la longueur de la liste et je trouve pas

Merci de ton aide

 

[sonskriverez]

Re : Bouger les mois par macro

Bonsoir le Forum

Pierrot désolé c'est moi qui à bouletté, j'avais juste modifié ton compteur. Ta solution fonctionne à merveille.

Merci beaucoup ainsi qu'à jmd2 et tous ceux qui ont lu mon post