Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

M

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
Mateusz54 à dit:
sauf que je me suis mal exprimé
Cliquez pour agrandir...
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...
Trier par date Trier par votes

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: 12
Vote positif 0 Vote négatif
M

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.
 
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
Mateusz54 à dit:
sauf que je me suis mal exprimé
Cliquez pour agrandir...
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: 10
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

C
  • Question
XL 2019 Nombre de semaines complètes (du lundi au dimanche) entre deux dates
Réponses
9
Affichages
468
CHAWI
C
C
  • Question
Microsoft 365 Compter le nombre de cellules remplies dans une colonne avec un critère dans une autre colonne
Réponses
2
Affichages
806
njhub
N
D
  • Question
Microsoft 365 Nombre d’occurrences sur une suite de noms
Réponses
0
Affichages
765
DavidMM
D
  • Résolu(e)
Microsoft 365 Ecart entre deux dates
Réponses
4
Affichages
398
Phytoman
C
  • Question
XL 2013 [VBA]Créer un nombre de ligne en fonction d'un certain nombre de colonne et remplir ces lignes avec certaines valeurs
Réponses
6
Affichages
461
CaptainSalt31
C
M
  • Question
XL 2010 Différence entre deux dates avec borne de fin
Réponses
4
Affichages
1 K
Deadpool_CC
P
  • Résolu(e)
Microsoft 365 Somme de cellule contenant des lettres
Réponses
6
Affichages
516
R@chid
F
  • Question
XL 2019 Calculer nombre de jours entre deux dates d'une base de donné
Réponses
6
Affichages
955
CISCO
A
  • Question
Microsoft 365 Lissage du budget sur nombre de jours du mois
2
Réponses
25
Affichages
3 K
aba2s
A
X
  • Résolu(e)
Microsoft 365 Détails heures par jour entre deux dates
Réponses
7
Affichages
1 K
xls_62
X
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…