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

jerome91

XLDnaute Junior
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
 

Pièces jointes

  • TEST1.xlsm
    15.5 KB · Affichages: 8

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous,

Sinon en VBA :
VB:
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

XLDnaute Barbatruc
Supporter XLD
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
VB:
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
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
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).
 

Pièces jointes

  • jerome91- duplication de lignes- v1.xlsm
    116.9 KB · Affichages: 5
Dernière édition:

jerome91

XLDnaute Junior
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
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi