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
| Function Dispo(an As String, mois As String, dernierjour As String)
Dim I As Integer 'compteur première boucle while
Dim j As Integer 'compteur seconde boucle while
Dim k As Integer
Dim l As Integer
Dim nom As String ' Nom de l'imprimante
Dim rep As String 'répetoire où se trouve le fichier à importer
Dim add As Integer
Dim moy As Single
Dim deb As Integer
Dim fin As Integer
Dim jourfin As Integer
Dim DerniereLigne As Long
Dim temp As Object
jourfin = Val(dernierjour)
I = 1
While Worksheets("References").Range("F" & I).Value <> "END" 'Parcour de la colonne du fichier référence
If (Worksheets("References").Range("F" & I).Value = "Dispo") Then 'quand il rencontre la valeur Dispo il commence le traitement
nom = Range("C" & I).Value
For j = 1 To jourfin
If j < 10 Then
rep = an & mois & "0" & j 'permet d'ecrire correctement le nom du répertoire
Else: rep = an & mois & j
End If
Call Import(rep, "E" & I, 0) 'importation du fichier
'*** Recherche la ligne des 8 heures***
' deb = 1
' While Worksheets("Buffer").Range("C" & deb).Value <> "08:"
' deb = deb + 1
' Wend
Dim v As Integer
On Error Resume Next
v = Application.Match("08:*", Worksheets("Feuil1").Columns("C"), 0)
On Error GoTo 0
If v <> 0 Then MsgBox "Trouvé ligne: " & v
'**** Recherche la ligne des 18 heures ***
fin = 1
While Worksheets("Buffer").Range("C" & fin).Value <> "18:"
fin = fin + 1
Wend
'*** Moyenne les valeurs entre 8heures et 18 heures ***
For k = deb To fin
add = add + Worksheets("Buffer").Range("E" & k).Value
Next k
moy = add / (fin - deb)
Worksheets("Buffer").Cells.Clear 'vide le fichier buffer
Worksheets("Dispo").Activate 'active la feuille qui correspond au type de données recto, rectoverso, A3,A4...
DerniereLigne = ActiveSheet.UsedRange.Row
DerniereLigne = Range("A1").CurrentRegion.End(xlDown).Row
DerniereLigne = Range("A65535").End(xlUp).Row
DerniereLigne = Range("A1").End(xlDown).Row
DerniereLigne = Range("A1").SpecialCells(xlCellTypeLastCell).Row
DerniereLigne = DerniereLigne + 1
Cells("A" & DerniereLigne).Value = nom
Cells(DerniereLigne, j).Value = moy
Next j
End If
I = I + 1
Wend
End Function |
Partager