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
|
Private Sub SommeDonnee()
On Error GoTo Err_SommeDonnee
Dim NbLgn As Integer, NbTotalJourOuvrer As Integer, idLgn As Integer
NbLgn = WorksheetFunction.CountA(Columns(1))
NbTotalJourOuvrer = networkdays("01/01/2005", Date) ' Calcul du nombre de jour ouvré depuis le 01/01/2005
For idLgn = 10 To NbLgn + 8
'Conso jour
If Cells(idLgn, 5) <> 0 Then
Cells(idLgn, 6) = Cells(idLgn, 5) / NbTotalJourOuvrer
Cells(idLgn, 6).NumberFormat = "0"
End If
' ----------------------------------------------------------------------------------------------------*
'Dispo a j
If Cells(idLgn, 6) <> 0 Then
Cells(idLgn, 7) = (Cells(idLgn, 10) + Cells(idLgn, 11) + Cells(idLgn, 12)) / Cells(idLgn, 6)
Cells(idLgn, 7).NumberFormat = "0"
End If
' ----------------------------------------------------------------------------------------------------*
'Dispo max
If Cells(idLgn, 6) <> 0 Then
Somme = 0
For i = 1 To 10
If i = 1 And i <= 3 Then Somme = Somme + Cells(idLgn, 9 + i)
If i >= 4 And i <= 8 Then Somme = Somme + Cells(idLgn, 14 + i)
If i >= 9 Then Somme = Somme + Cells(idLgn, 15 + i)
Next
Cells(idLgn, 8) = Somme / Cells(idLgn, 6)
Cells(idLgn, 8).NumberFormat = "0"
End If
' ----------------------------------------------------------------------------------------------------*
'Dispo max (20%)
If Cells(idLgn, 8) <> 0 Then
Cells(idLgn, 9) = Cells(idLgn, 8) * 0.8
Cells(idLgn, 9).NumberFormat = "0"
End If
' ----------------------------------------------------------------------------------------------------*
'Stock mini
If Cells(idLgn, 6) <> 0 Then
Cells(idLgn, 29) = Cells(idLgn, 6) * 2
Cells(idLgn, 29).NumberFormat = "0"
End If
' ----------------------------------------------------------------------------------------------------*
'Ecart-type
Cells(idLgn, 30) = (Cells(idLgn, 10) + Cells(idLgn, 11)) - Cells(idLgn, 6)
Cells(idLgn, 30).NumberFormat = "0"
' ----------------------------------------------------------------------------------------------------*
'Priorite
If Cells(idLgn, 10) <> 0 Or Cells(idLgn, 6) <> 0 Then
If Cells(idLgn, 10) < Cells(idLgn, 6) Then
Cells(idLgn, 31) = "A"
ElseIf (Cells(idLgn, 10) > Cells(idLgn, 6)) And (Cells(idLgn, 10)) < (Cells(idLgn, 6) * 2) Then
Cells(idLgn, 31) = "B"
ElseIf Cells(idLgn, 10) > Cells(idLgn, 6) Then
Cells(idLgn, 31) = "C"
End If
End If
Next
Exit Sub
Err_SommeDonnee:
Call EnvoiMailErr("SommeDonnee", Err.Description)
End Sub |
Partager