Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Macro pour générer colonne Date et Heure

Macro pour générer colonne Date et Heure

28 réponses
Avatar
Christophe Joly
Bonsoir:



Je cherche de l'aide pour creer une macro qui permettrait grace à une input
box demandant 5 variables

1- date Début

2- date Fin

3- Heure Début

4- Heure Fin

3- Incrément Heure



de générer une colonne Date/Heure



Par exemple en rentant:

1- 6/17/03

2- 6/19/03

3- 9:00 AM

4- 6:00PM

5- 30 mn



Je veux génerer

6/17/03 9:00 AM

6/17/03 9:30 AM

6/17/03 10:00 AM

6/17/03 10:30 AM

6/17/03 11:00 AM

6/17/03 11:30 AM

6/17/03 12:00 PM

6/17/03 12:30 PM

6/17/03 1:00 PM

6/17/03 1:30 PM

6/17/03 2:00 PM

6/17/03 2:30 PM

6/17/03 3:00 PM

6/17/03 3:30 PM

6/17/03 4:00 PM

6/17/03 4:30 PM

6/17/03 5:00 PM

6/17/03 5:30 PM

6/17/03 6:00 PM

6/18/03 9:00 AM

6/18/03 9:30 AM

6/18/03 10:00 AM

6/18/03 10:30 AM

6/18/03 11:00 AM

6/18/03 11:30 AM

6/18/03 12:00 PM

6/18/03 12:30 PM

6/18/03 1:00 PM

6/18/03 1:30 PM

6/18/03 2:00 PM

6/18/03 2:30 PM

6/18/03 3:00 PM

6/18/03 3:30 PM

6/18/03 4:00 PM

6/18/03 4:30 PM

6/18/03 5:00 PM

6/18/03 5:30 PM

6/18/03 6:00 PM

6/19/03 9:00 AM

6/19/03 9:30 AM

6/19/03 10:00 AM

6/19/03 10:30 AM

6/19/03 11:00 AM

6/19/03 11:30 AM

6/19/03 12:00 PM

6/19/03 12:30 PM

6/19/03 1:00 PM

6/19/03 1:30 PM

6/19/03 2:00 PM

6/19/03 2:30 PM

6/19/03 3:00 PM

6/19/03 3:30 PM

6/19/03 4:00 PM

6/19/03 4:30 PM

6/19/03 5:00 PM

6/19/03 5:30 PM

6/19/03 6:00 PM



Merci d'avance.



Christophe
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
Daniel.M
Salut Christophe,

ce qui me satisfait totalement à moins que tu y decele une faille.


J'y ai vu une dépendance avec la valeur du Pas.
Essaie avec 00:15 comme Incrément.

j'aimerai que ce résultat se colle dans la colonne B2.Bx d'une
feuille protégé (sans mot de passe) appelé "Country Appointments" mais en
gardant le format des cellules de destinations (date et ombrage de cellule).


Peut-être cela:

Sub DMA_IncrDateEtTemps()
' Daniel M.
Dim Jr1 As Date, Jr2 As Date, Hh1 As Date, Hh2 As Date, Pas As Date
Dim V As Variant
Dim nParJour As Integer, nJours As Integer, s As String

Jr1 = CDate(InputBox("Starting Date e.g. 06/14/03", "", "06/14/2003"))
Jr2 = CDate(InputBox("Ending Date e.g.06/16/03", "", "06/16/2003"))
Hh1 = CDate(InputBox("Starting Time e.g. 9:00 AM", "", "9:00"))
Hh2 = CDate(InputBox("Ending Time e.g. 6:00 PM", "", "18:00"))
Pas = CDate(InputBox("Increment e.g. 00:30", "", "00:30"))

nParJour = Int((Hh2 - Hh1) / Pas) + 1
nJours = 1 + Jr2 - Jr1

s = "TRANSPOSE(MOD(ROW(1:" & nParJour * nJours & ")-1," & _
nParJour & "))*" & CDbl(Pas) & _
"+TRANSPOSE(INT((ROW(1:" & nParJour * nJours & _
")-1)/" & CDbl(nParJour) & "))+" & CDbl(Jr1 + Hh1)

V = Evaluate(s)

Sheets("Country Appointments").Range("B2").Resize(nParJour _
* nJours).Value = Application.Transpose(V)

End Sub



"Christophe Joly" wrote in message
news:
Bonsoir Alain:

La proposition "1/2 clou" est pas si mal que ca.



Avatar
Daniel.M
J'ai oublié de mentionner qu'il faut déprotéger ta feuille avant l'instruction
Sheets("...").Range...


et remettre la protection immédiatement après.

Tu dois donc utiliser les méthodes Sheets("...").UnProtect et .Protect

Salutations, (dodo)

Daniel M.
Avatar
AV
Salut Daniel,

J'y ai vu une dépendance avec la valeur du Pas.
Essaie avec 00:15 comme Incrément.


J'avais repéré ce smilblick...
Ainsi qu'un autre (que ta proposition ne résoud pas non plus ;-) :
Ex : H début = 18:00 et H fin 05:00 (lendemain)

J'ai laissé le truc en chantier en attendant qques loisirs...
AV

Avatar
Daniel.M
Salut Alain,

Ainsi qu'un autre (que ta proposition ne résoud pas non plus ;-) :
Ex : H début = 18:00 et H fin 05:00 (lendemain)


Je croyais vraiment que HDébut serait toujours plus petite que HFin.

T'es sûr que le requérant veut cela ou si c'est pas ton esprit tordu qui fait
des siennes ;-))

Plus sérieusement, on peut adapter en définissant nParJour pour qu'il tienne
compte de cette possibilité.

nParJour = ((Hh2 - Hh1 + IIf(Hh2 < Hh1, 1, 0)) / Pas) + 1

Salutations,

Daniel M.

Avatar
AV
T'es sûr que le requérant veut cela ou si c'est pas ton esprit tordu qui fait
des siennes ;-))


Ben non pas tordu ! Et les 3 x 8 ça n'existe plus outre-atlantique ? ;-)
C'est juste pour faire avec une question particulière, une réponse
générale(--rique)

AV

Avatar
Christophe Joly
Daniel et Alain Bonsoir:

Le requérant est très content de la dernière proposition de Daniel qui
intègre également le coller dans la feuille "Country Appointments". Pour ma
part j'ai fait un essai avec un pas de 00:30 et de 00:20 sans constater de
smilblick particulier notamment par ce que je rentre des heures au format
americain AM et PM mais peut etre j'ai raté quelque chose.

Merci à vous deux ainsi qu'à Isabelle pour votre contribution active,
pertinente et inventive.

Christophe


"Daniel.M" a écrit dans le message de
news:
J'ai oublié de mentionner qu'il faut déprotéger ta feuille avant
l'instruction

Sheets("...").Range...


et remettre la protection immédiatement après.

Tu dois donc utiliser les méthodes Sheets("...").UnProtect et .Protect

Salutations, (dodo)

Daniel M.




Avatar
Daniel.M
Merci Christophe.

Essaie cette dernière version (plus solide pour arrêter à temps):

Sub DMA_IncrDateEtTemps()
' Daniel M.
Dim Jr1 As Date, Jr2 As Date, Hh1 As Date, Hh2 As Date, Pas As Date
Dim V As Variant, s As String
Dim nParJour As Integer, nIntervalles As Integer

Jr1 = CDate(InputBox("Starting Date e.g. 06/14/03", "", "06/14/2003"))
Jr2 = CDate(InputBox("Ending Date e.g.06/16/03", "", "06/16/2003"))
Hh1 = CDate(InputBox("Starting Time e.g. 9:00 AM", "", "23:00"))
Hh2 = CDate(InputBox("Ending Time e.g. 6:00 PM", "", "01:00"))
Pas = CDate(InputBox("Increment e.g. 00:30", "", "00:30"))

nParJour = Int(((Hh2 - Hh1 + IIf(Hh2 < Hh1, 1, 0)) / Pas + _
0.000001)) + 1
nIntervalles = (1 + Jr2 - Jr1) * nParJour

s = "TRANSPOSE(MOD(ROW(1:" & nIntervalles & ")-1," & _
nParJour & "))*" & CDbl(Pas) & _
"+TRANSPOSE(INT((ROW(1:" & nIntervalles & _
")-1)/" & CDbl(nParJour) & "))+" & CDbl(Jr1 + Hh1)

V = Evaluate(s)

Sheets("Country Appointments").Unprotect
Sheets("Country Appointments").Range("B2").Resize(nIntervalles) Application.Transpose(V)
Sheets("Country Appointments").Protect
End Sub


Salutations,

Daniel M.

"Christophe Joly" wrote in message
news:
Daniel et Alain Bonsoir:

Le requérant est très content de la dernière proposition de Daniel qui
intègre également le coller dans la feuille "Country Appointments". Pour ma
part j'ai fait un essai avec un pas de 00:30 et de 00:20 sans constater de
smilblick particulier notamment par ce que je rentre des heures au format
americain AM et PM mais peut etre j'ai raté quelque chose.

Merci à vous deux ainsi qu'à Isabelle pour votre contribution active,
pertinente et inventive.

Christophe



Avatar
Christophe Joly
Daniel:

Merci a toi. Ta nouvelle version me convient tout autant que la premiere
mais puisque tu me dis qu'elle est encore mieux je l'ai déjà adopté.

5U

Christophe
"Daniel.M" a écrit dans le message de
news:uQQH%
Merci Christophe.

Essaie cette dernière version (plus solide pour arrêter à temps):

Sub DMA_IncrDateEtTemps()
' Daniel M.
Dim Jr1 As Date, Jr2 As Date, Hh1 As Date, Hh2 As Date, Pas As Date
Dim V As Variant, s As String
Dim nParJour As Integer, nIntervalles As Integer

Jr1 = CDate(InputBox("Starting Date e.g. 06/14/03", "", "06/14/2003"))
Jr2 = CDate(InputBox("Ending Date e.g.06/16/03", "", "06/16/2003"))
Hh1 = CDate(InputBox("Starting Time e.g. 9:00 AM", "", "23:00"))
Hh2 = CDate(InputBox("Ending Time e.g. 6:00 PM", "", "01:00"))
Pas = CDate(InputBox("Increment e.g. 00:30", "", "00:30"))

nParJour = Int(((Hh2 - Hh1 + IIf(Hh2 < Hh1, 1, 0)) / Pas + _
0.000001)) + 1
nIntervalles = (1 + Jr2 - Jr1) * nParJour

s = "TRANSPOSE(MOD(ROW(1:" & nIntervalles & ")-1," & _
nParJour & "))*" & CDbl(Pas) & _
"+TRANSPOSE(INT((ROW(1:" & nIntervalles & _
")-1)/" & CDbl(nParJour) & "))+" & CDbl(Jr1 + Hh1)

V = Evaluate(s)

Sheets("Country Appointments").Unprotect
Sheets("Country Appointments").Range("B2").Resize(nIntervalles) > Application.Transpose(V)
Sheets("Country Appointments").Protect
End Sub


Salutations,

Daniel M.

"Christophe Joly" wrote in message
news:
Daniel et Alain Bonsoir:

Le requérant est très content de la dernière proposition de Daniel qui
intègre également le coller dans la feuille "Country Appointments".
Pour ma


part j'ai fait un essai avec un pas de 00:30 et de 00:20 sans constater
de


smilblick particulier notamment par ce que je rentre des heures au
format


americain AM et PM mais peut etre j'ai raté quelque chose.

Merci à vous deux ainsi qu'à Isabelle pour votre contribution active,
pertinente et inventive.

Christophe







1 2 3