Traitement fichier
Bonjour,
j'ai un gros problème car je n'arrive pas à traiter mes données.
je gère 4 armoires sur 4 sites différents (CAM-CTM-CITY ET CCAS).
tous les jours il me remonte les réservations de véhicules des 4 armoires.
sous la forme suivante :
- date de départ
- heure de départ
- date de retour
- heure de retour
- numéro du véhicule (PAR-...)
donc une feuille par armoire.
dans mon fichier j'ai un onglet Export et un onglet Fin.
ce que je veux faire :
dans l'onglet Fin j'ai des consignes (en jaune):
- l'armoire à traiter pour l'export
- le type de véhicule (1000-2000-3000 suivant le numéro du véhicule les milles sont des 4-5 places les 2000 des fourgonnette et 3000 des fourgons).
- une date.
il faut rappatrier dans l'onglet Export les véhicules correspondant à ces critères (attention il arrive qu'un véhicule sorte sur plusieurs jours donc prendre en compte ceci).
par exemple si j'ai le PAR-1408 qui sort du 3/01 au 10/01 si je demande la date du 5/01 il faudra que ce véhicule remonte dans Export (il faut donc annalyser les deux dates départ et retour).
ensuite mettre dans l'onglet Fin :
- colonne A les numéros des véhicules se trouvant dans l'onglet export (attention si le véhicule apparait plusieurs fois ne le mettre qu'une fois.
- sur la ligne 1 j'ai les plages d'horaire (de 0h à 1h de 1h à 2 h etc...)
il faut ensuite mettre un 1 si le véhicule est sortie pendant cette plage et rien s'il est présent.
le but est de savoir si mon Park est bon ou s'il y a trop de véhicule ou pas assez.
cette macro sera à déclencher avec un bouton.
à l'avance un grand merci car pour le moment je le fais à la main et c'est galére.
peut-être pour faire avancer. j'ai cela comme macro sur un fichier qui me sert de calcul du nombre de sortie:
dans la feuille Export
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract, dDate As Date, iDif1%, iDif2%, iHr1%, iHr2%, iEnd%
'
Cancel = True
tData = Range("A4").Resize(Range("A" & Rows.Count).End(xlUp).Row - 3, 4).Value
'
With Worksheets("Fin")
.Range("A2:Y" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Delete shift:=xlUp
tExtract = .Range("A2:Y" & 2 + DateDiff("d", CDate([A4]), CDate(Range("A" & Rows.Count).End(xlUp).Value))).Value
dDate = CDate(tData(1, 1)) - 1
For x = 1 To UBound(tData, 1)
iDif1 = DateDiff("d", dDate, CDate(tData(x, 1)))
iDif2 = DateDiff("d", dDate, CDate(tData(x, 3)))
iEnd = IIf(iDif2 > iEnd, iDif2, iEnd)
iHr1 = CInt(Split(tData(x, 2), "h")(0)) + 1
iHr2 = CInt(Split(tData(x, 4), "h")(0)) + IIf(CInt(Split(tData(x, 4), "h")(1)) > 0, 1, 0)
For y = iDif1 To iDif2
tExtract(y, 1) = DateAdd("d", y, dDate)
For Z = IIf(y = iDif1, 1 + iHr1, 2) To IIf(y = iDif2 Or iDif1 = iDif2, 1 + iHr2, 25)
tExtract(y, Z) = CInt(tExtract(y, Z)) + 1
Next
Next
Next
.Range("A2").Resize(iEnd, 25).Value = tExtract
.Activate
End With
'
End Sub
dans la feuille Fin :
Private Sub Worksheet_Activate()
'
Dim tData, tExtract, dDate As Date, iDif1%, iDif2%, iHr1%, iHr2%, iEnd%
'
Application.ScreenUpdating = False
'
With Worksheets("Export")
tData = .Range("A4").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 3, 4).Value
Range("A2:Y" & Range("A" & Rows.Count).End(xlUp).Row + 1).Delete shift:=xlUp
tExtract = Range("A2:Y" & 2 + DateDiff("d", CDate(.[A4]), CDate(.Range("A" & Rows.Count).End(xlUp).Value))).Value
End With
'
dDate = CDate(tData(1, 1)) - 1
For x = 1 To UBound(tData, 1)
iDif1 = DateDiff("d", dDate, CDate(tData(x, 1)))
iDif2 = DateDiff("d", dDate, CDate(tData(x, 3)))
iEnd = IIf(iDif2 > iEnd, iDif2, iEnd)
iHr1 = CInt(Split(tData(x, 2), "h")(0)) + 1
iHr2 = CInt(Split(tData(x, 4), "h")(0)) + IIf(CInt(Split(tData(x, 4), "h")(1)) > 0, 1, 0)
For y = iDif1 To iDif2
tExtract(y, 1) = DateAdd("d", y, dDate)
For Z = IIf(y = iDif1, 1 + iHr1, 2) To IIf(y = iDif2 Or iDif1 = iDif2, 1 + iHr2, 25)
tExtract(y, Z) = CInt(tExtract(y, Z)) + 1
Next
Next
Next
Range("A2").Resize(iEnd, 25).Value = tExtract
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 2
Range("A" & x & ":Y" & x).Interior.Color = RGB(215, 215, 215)
Next
Range("A2:Y" & Range("A" & Rows.Count).End(xlUp).Row).BorderAround LineStyle:=xlContinuous
'
Application.ScreenUpdating = True
'
End Sub
mais le problème c'est que cela me compte le nombre de sortie donc si un véhicule rentre à 10h15 et repart à 10h48 et bien dans mon tableau j'ai la valeure 2 dans la colonne 10-11 au lieu de n'avoir que 1 qui correspond à un même véhicule sortie.
Bonjour,
Avec du Sql on peut faire un tableau au quart d'heure
La requête est relativement simple :
Req = "SELECT `N° veh`"
For i = 0 To 24 * 4
Qrt = Replace(Format(Dt + (i / 24 / 4), "0.##"), ",", ".")
Req = Req & ", SUM(IIF(" & Qrt & _
" BETWEEN `DATE DE DEBUT`+`HEURE DE DEBUT` AND `DATE DE FIN`+`HEURE DE FIN`,1,0)) "
Next i
Req = Req & " FROM [" & Tbl & "$A:E]" & _
" WHERE " & Dt & " BETWEEN `DATE DE DEBUT` AND `DATE DE FIN`" & _
" AND `N° veh` LIKE 'PAR-" & Typ & "%'" & _
" GROUP BY `N° veh`" & _
" ORDER BY `N° veh`"
Il est juste nécessaire de transformer les heures "12h45" au format "12:45" (ce format est toujours plus facile à manier avec excel), et d'ajouter une ligne d'entête standard dans les onglet de données.
Le fichier du zip est à décompresser dans un dossier de son PC
Pierre
WAOUUUUUUUUU,
SUPERBE JE NE CONNAISSAIS PAS.
JE VAIS ANALYSER TOUT CELA MAIS CA FONCTIONNE;
UN GRAND MERCI.
juste une dernière question comment mettre les valeurs des ComboBox (CTM-CAM-CITY-CCAS et 0000-1000-2000-3000) dans une feuille qui s'appel "GRAF" en A1 et A2 car j'ai des calculs à mettre en place par rapport à ces deux valeurs.
Merci
En ajoutant 2 lignes simplement comme ceci =>
Sub Bilan()
Dim T As Variant
With Sheets("Fin")
T = T_Bilan(.Range("A1").Value, .ComboBox1.Value, .ComboBox2.ListIndex)
.Range("A3:CS1000").ClearContents
.Range("A3").Resize(UBound(T, 1), UBound(T, 2)) = T
Sheets("Graph").Range("A1").Value = .ComboBox1.Value
Sheets("Graph").Range("A2").Value = .ComboBox2.Value
End With
End Sub
Pierre
Bonjour,
merci infiniment cela fonctionne à merveille.
Bonne journée.