Résolu 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 :)
 
Ce fil a été résolu! Aller à la solution…
Dernière édition:

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.
 

Fichiers joints

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
 
Ce message a été identifié comme étant une solution!

Fichiers joints

Mateusz54

XLDnaute Nouveau
Merci beaucoup, c'est tout à fait ce que j'ai recherché :)
J'ai pas tout compris, surtout l'histoire de "Lw", mais ça marche nickel!
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas