1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
| Option Explicit ' Statistiques mensuelles des heures on peak vs. off peak
' ============================== Nom de la feuille source
Public Const nomFeuilleSource = "Relevées"
Public Const rowReleve = 2 ' Première rangée de relevé
Public Const colDate = 1 ' Première colonne A de date en pas demi horaire
Public Const colVolume = colDate + 1 ' Volume du relevé
Public Const dateOnPeakStart = #8:00:00 AM# ' Heure de début heure pleine
Public Const dateOnPeakEnd = #8:59:59 PM# ' Heure de fin heure pleine
' ============================== Nom de la feuille résultat
Public Const nomFeuilleCible = "Statistique par mois"
Public Const rowStatMonth = 2 ' Première rangée de statistique mensuelle
Public Const colMonth = 1 ' Première colonne d'affichage des statistiques par mois
Public Const colOnPeak = colMonth + 1 ' Colonne heures pleines
Public Const colOffPeak = colOnPeak + 1 ' Colonne heures creuses
' Point d'entrée principal qui parcourt les relevées par demi pas horaires
Sub OnOffPeak()
Dim indRowDate As Integer, indRowMonth As Integer
Dim dateRelevee As Date, dateMonth As Date, monthCurrent As Integer, timeReleve As Date
Dim volumeReleve As Long, volOnPeak As Long, volOffPeak As Long
Dim wSheetSource As Worksheet, wSheetCible As Worksheet
Set wSheetSource = FeuilleParNom(nomFeuilleSource)
Set wSheetCible = FeuilleParNom(nomFeuilleCible)
If wSheetSource.Name = wSheetCible.Name Then Stop: End ' Erreur pas dans la même feuille
indRowDate = rowReleve ' Première ligne de la feuille source
indRowMonth = rowStatMonth ' Première ligne de la feuille cible
monthCurrent = 0: volOnPeak = 0: volOffPeak = 0
With wSheetSource
While .Cells(indRowDate, colDate) <> "" ' Boucle tant que la ligne n'est pas vide
dateRelevee = DateUsToFr(.Cells(indRowDate, colDate)) ' Date du relevé
If Month(dateRelevee) <> monthCurrent Then ' Nouveau mois
If monthCurrent > 0 Then ' Il y a un cumul de relevés du précédent mois
DisplayVolumeByMonth wSheetCible, dateMonth, volOnPeak, volOffPeak, indRowMonth
End If
dateMonth = dateRelevee
monthCurrent = Month(dateRelevee) ' Changement du mois courant
volOnPeak = 0: volOffPeak = 0 ' Remise à zéro des cumuls des heures
End If
volumeReleve = .Cells(indRowDate, colVolume) ' Conso du relevé
timeReleve = dateRelevee - Int(dateRelevee) ' Extrait l'heure de la date
If timeReleve >= dateOnPeakStart And timeReleve <= dateOnPeakEnd Then
volOnPeak = volOnPeak + volumeReleve ' Cumul heures pleines
Else
volOffPeak = volOffPeak + volumeReleve ' Cumul heures creuses
End If
indRowDate = indRowDate + 1 ' Prochaine ligne
Wend
End With
If volOnPeak > 0 Or volOffPeak > 0 Then ' Dernier mois
DisplayVolumeByMonth wSheetCible, dateMonth, volOnPeak, volOffPeak, indRowMonth
End If
End Sub
' Convertir de "MM/DD/YYY" vers "DD/MM/YYYY"
Function DateUsToFr(ByVal strDateUs As String) As Date
Const indSlash1 = 3, indSlash2 = indSlash1 * 2
Dim strDateFr As String
If Mid(strDateUs, indSlash1, 1) = "/" And Mid(strDateUs, indSlash2, 1) = "/" Then
strDateFr = Mid(strDateUs, indSlash1 + 1, indSlash1) + Mid(strDateUs, 1, indSlash1) + _
Mid(strDateUs, indSlash2 + 1) ' Inverse le mois et le jour
Else
strDateFr = strDateUs ' Conversion non possible
End If
On Error Resume Next
DateUsToFr = CDate(strDateFr)
If Err.Number <> 0 Then Stop: End ' Date au format inconnu
On Error GoTo 0
End Function
' Accède à une feuille par son nom. C'est la feuille courante si non trouvée
Function FeuilleParNom(ByVal strNomFeuille As String) As Worksheet
On Error Resume Next
Set FeuilleParNom = Worksheets(strNomFeuille)
If Err.Number <> 0 Then Stop: End ' Gestion d'erreur. Feuille inconnue
On Error GoTo 0
End Function
' Affichage du résultat des statistiques mensuelles des heures on peak vs. off peak
Sub DisplayVolumeByMonth(wSheetCible As Worksheet, ByVal dateMonth As Date, _
ByVal volOnPeak As Long, ByVal volOffPeak As Long, ByRef indRowMonth As Integer)
Const strFormatDate = "MMM-YY"
Dim strMonthYear As String
strMonthYear = Format(dateMonth, strFormatDate)
With wSheetCible
.Cells(indRowMonth, colMonth) = strMonthYear
.Cells(indRowMonth, colOnPeak) = volOnPeak
.Cells(indRowMonth, colOffPeak) = volOffPeak
End With
Debug.Print strMonthYear & " " & volOnPeak & " " & volOffPeak
indRowMonth = indRowMonth + 1 ' Prochaine ligne de statistiques du mois
End Sub |
heures onpeak offpeak
Répondre avec citation
Envoyé par sarah2001
Partager