XL 2021 Macro : avoir les mois en chiffres de 1 à 12 en colonne à chaque ligne différente

[jerome91]

Bonjour à tous,
J'aurais besoin de votre aide pour créer un code VBA qui permettrait d'écrire les chiffres des mois de 1 à 12 en colonne à chaque changement d'agences.
A date, il y a une macro qui créée 11 lignes à chaque changement d'agences.
Avant la macro :
ligne 4 : AAA | AAA | AAA
ligne 5 : BBB | BBB | BBB
et ensuite à la fin la macro me permet d'avoir 12 lignes à chaque fois donc 12 lignes par agence.
Je souhaiterais une macro ou tout du moins la suite pour écrire dans la colonne D les mois 1, 2 ..., jusque 12.
Pour le moment, il y a deux agences mais il y en aura plus.
Merci pour votre aide.
Jérôme

 

[Jeannette]

Bonsoir,
Pour obtenir ce que tu veux, je n'utilise pas de macro, mais Power Query.
A partir du tableau de gauche, nommé "t_source"
La mise à jour peut se faire via le bouton "Actualiser" du ruban "Données"

 

[jerome91]

Bonsoir,
Pour obtenir ce que tu veux, je n'utilise pas de macro, mais Power Query.
A partir du tableau de gauche, nommé "t_source"
La mise à jour peut se faire via le bouton "Actualiser" du ruban "Données"

Bonjour Jeannette,
Merci pour votre réponse.
Jérôme

 

[mapomme]

Bonsoir à tous,

Sinon en VBA :

Sub TEST()
Dim i As Long, N As Long
   Application.ScreenUpdating = False
   N = Range("A" & Rows.CountLarge).End(xlUp).Row
   For i = N To 4 Step -1: Rows(i).Copy: Rows(i).Resize(11).Insert: Next
   N = Range("A" & Rows.CountLarge).End(xlUp).Row
   Range("d4:d" & N).Formula = "=1+MOD(ROW()-4,12)"
   Range("d4:d" & N) = Range("d4:d" & N).Value
   Application.CutCopyMode = False
End Sub

 

[mapomme]

Re,

Un code un peu plus long mais beaucoup plus rapide pour dupliquer les valeurs et compléter la colonne D.

Pour 1 000 lignes à dupliquer (soit 12 000 lignes pour résultat) sur mon PC :

• la première méthode ci-dessus (copie puis insertion) prend 15 s
• la seconde méthode ci-dessous (tableaux en mémoire) prend 0,1 s

Sub test2()
Dim n As Long, t, i As Long, j As Long, k As Long
   Application.ScreenUpdating = False
   n = Range("A" & Rows.CountLarge).End(xlUp).Row
   t = Range("a4:c" & n)
   ReDim r(1 To 12 * UBound(t), 1 To UBound(t, 2) + 1): n = 0
   For i = 1 To UBound(t)
      For k = 1 To 12
         n = n + 1
         For j = 1 To UBound(t, 2): r(n, j) = t(i, j): Next j
         r(n, UBound(r, 2)) = k
      Next k
   Next i
   Range("a4").Resize(UBound(r), UBound(r, 2)) = r
End Sub

 

[mapomme]

Re,

Un classeur avec trois méthodes :

1. la méthode initiale très longue (env. 26 s) et pouvant bloquer Excel si trop de lignes sont à dupliquer
2. la méthode initiale accélérée (env. 1 s)
3. la méthode via des arrays en mémoire (env. 0,2 s)

Les codes sont dans module1.

nota : les exemples dupliquent 2 000 lignes de données sources (soit 24 000 lignes au niveau du résultat).

 

[jerome91]

Re,

Un classeur avec trois méthodes :

1. la méthode initiale très longue (env. 26 s) et pouvant bloquer Excel si trop de lignes sont à dupliquer
2. la méthode initiale accélérée (env. 1 s)
3. la méthode via des arrays en mémoire (env. 0,2 s)

Les codes sont dans module1.

nota : les exemples dupliquent 2 000 lignes de données sources (soit 24 000 lignes au niveau du résultat).

Bonjour,
Merci beaucoup,
Jérome