XL 2010 Solution VBA pour créer/copie des lignes en fonction du nombre de jours entre deux dates

Mateusz54

XLDnaute Nouveau
Bonjour à tous,

Je bloque sur un problème.
Il me semblais que je vais pouvoir le régler par VBA, mais malheureusement j'arrive pas :(
J'ai besoin de copier des lignes d'une feuille sur une autre mais en les pressentant différemment. Je m'explique :
Sur le premier onglet j'ai des informations suivantes : N°, NOM, DATE_DEB, DATE_FIN, NB JRS (difference entre 2 dates). Par Exemple, sur les colonnes A, B, C, D et E :

A ; B ; C ; D ;E
001; XXXXX; 21/09/2020; 23/09/2020; 3
001; XXXXX; 28/09/2020; 01/10/2020; 4
002; YYYYY; 21/09/2020; 22/09/2020; 2
etc.

Je voudrais transcrire ces informations sur mon deuxième onglet mais avoir un résultat "jour par jour", donc pour chaque personne autant de lignes que jours entre date déb et date fin :
A ; B ; C ; D ;E
001; XXXXX; 21/09/2020; 21/09/2020; 1
001; XXXXX; 22/09/2020; 22/09/2020; 1
001; XXXXX; 23/09/2020; 23/09/2020; 1
001; XXXXX; 28/09/2020; 28/09/2020; 1
001; XXXXX; 29/09/2020; 29/09/2020; 1
001; XXXXX; 30/09/2020; 30/09/2020; 1
001; XXXXX; 01/10/2020; 10/10/2020; 1
002; YYYYY; 21/09/2020; 21/09/2020; 1
002; YYYYY; 22/09/2020; 22/09/2020; 1

Mon problème c'est que je suis pas assez fort pour faire des boucles... Si quelqu'un a une solution ou une piste au moins,
je vous serai reconnaissant :)
 
Dernière édition:
Solution
sauf que je me suis mal exprimé
Entièrement d'accord. :)
Car en fait c'est beaucoup plus simple avec :
VB:
Sub Transfert()
Sheets("Feuil2").Range("A:E").ClearContents     ' Efface matrice de sortie
DerLig = Range("A65500").End(xlUp).Row          ' Récupère nombre ligne matrice d'entrée
Lw = 1                                          ' Indice d'écriture
For L = 1 To DerLig                             ' Pour toutes les lignes
    DateVal = CDate(Cells(L, 3))                ' Récupération date initiale
    For N = 1 To Cells(L, 5)                    ' De 1 jusqu'au nombre demandé dans la chaine
        Sheets("Feuil2").Cells(Lw, 1) = Cells(L, 1)
        Sheets("Feuil2").Cells(Lw, 2) = Cells(L, 2)
        Sheets("Feuil2").Cells(Lw...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Mateusz,
En PJ un essai avec :
VB:
Sub Transfert()
Sheets("Feuil2").Range("A:A").ClearContents     ' Efface matrice de sortie
DerLig = Range("A65500").End(xlUp).Row          ' Récupère nombre ligne matrice d'entrée
Lw = 1                                          ' Indice d'écriture
For L = 1 To DerLig                             ' Pour toutes les lignes
    tablo = Split(Range("A" & L), ";")          ' Met la chaine dans un tablo splitté avec séparateur ";"
    DateVal = CDate(tablo(2))                   ' Met en nombre la chaine Date
    For N = 1 To tablo(4)                       ' De 1 jusqu'au nombre demandé dans la chaine
        ' Reconstruit la chaine de sortie ( DateVal+N+1 donne la date demandée )
        Sheets("Feuil2").Cells(Lw, 1) = tablo(0) & ";" & tablo(1) & ";" & DateVal + N - 1 & ";" & DateVal + N - 1 & ";" & "1"
        Lw = Lw + 1                             ' Incrément ligne de sortie
    Next N
Next L
End Sub
Si j'ai bien tout compris.
 

Pièces jointes

  • Essai.xlsm
    16.7 KB · Affichages: 11

Mateusz54

XLDnaute Nouveau
Merci!
ça a l'air bien et ça fonctionne sauf que je me suis mal exprimé.... :(
Chaque donnée est dans une colonne séparée (c'est un tableau au faite).
Donc A (N°); B(NOM); C(date_deb); D (Date fin) et en E (NB JRS). Et en sortie je voudrais également obtenir un tableau sur 5 colonnes.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
sauf que je me suis mal exprimé
Entièrement d'accord. :)
Car en fait c'est beaucoup plus simple avec :
VB:
Sub Transfert()
Sheets("Feuil2").Range("A:E").ClearContents     ' Efface matrice de sortie
DerLig = Range("A65500").End(xlUp).Row          ' Récupère nombre ligne matrice d'entrée
Lw = 1                                          ' Indice d'écriture
For L = 1 To DerLig                             ' Pour toutes les lignes
    DateVal = CDate(Cells(L, 3))                ' Récupération date initiale
    For N = 1 To Cells(L, 5)                    ' De 1 jusqu'au nombre demandé dans la chaine
        Sheets("Feuil2").Cells(Lw, 1) = Cells(L, 1)
        Sheets("Feuil2").Cells(Lw, 2) = Cells(L, 2)
        Sheets("Feuil2").Cells(Lw, 3) = DateVal + N - 1
        Sheets("Feuil2").Cells(Lw, 4) = DateVal + N - 1
        Sheets("Feuil2").Cells(Lw, 5) = 1
        Lw = Lw + 1                             ' Incrément ligne de sortie
    Next N
Next L
End Sub
 

Pièces jointes

  • Essai2.xlsm
    16.8 KB · Affichages: 8

Discussions similaires

Statistiques des forums

Discussions
293 048
Messages
1 928 125
Membres
183 855
dernier inscrit
safelhr