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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
| Sub calculEFF()
Dim Duree As Double, T As Double
'Dim wsPP As Worksheet, Activite As String, Nbrediag As String, date_deb As Date
Dim wsPP As Worksheet, Activite As String, Nbrediag As Long, date_deb As Date
Set wsPP = Sheets("Planning du personnel")
With wsPP
finlist = .Range("A1000").End(xlUp).Row
fincol = .Range("XFD5").End(xlToLeft).Column
date_deb = InputBox("Date ?", "Quelle sera la date de début du calcul", Date)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'recherche de la premiere colonne de départ et de la colonne de fin
c = 6
For c = 6 To fincol
If .Cells(4, c) = date_deb Then
coldep = c
Exit For
End If
Next
T = Timer
'demarrage du calcul à la date donnée précédement
i = 7
e = 24
Effectif1 = 0
Effectif2 = 0
Nbrediag = 0
cpteur = 0
Set rg = wsPP.Range(Cells(1, 1), Cells(finlist, fincol))
Dim table
table = rg.Value
NonContinuous = 64 ^ 9
For c = coldep To fincol
For e = 25 To finlist
If .Cells(e, c).Borders(xlDiagonalUp).LineStyle <> xlContinuous Then
table(e, c) = NonContinuous
nbr = nbr + 1
End If
Next
Next
cpteur = 0
For c = coldep To fincol
For i = 7 To 21
'determination du nombre de personne suivant l'activté renseigné dans la colonne D
Activite = table(i, 4) 'Activite = .Cells(i, 4)
For e = 25 To finlist 'For e = 24 To finlist
If table(e, c) = Activite Then ' If .Cells(e, c).Value = Activite Then
If table(e, c) <> NonContinuous Then 'If .Cells(e, c).Borders(xlDiagonalUp).LineStyle = xlContinuous Then
Nbrediag = Nbrediag + 1
End If
End If
Next e
'Compte le nombre de personne présente et déduit les 1/2 journée
Effectif1 = WorksheetFunction.CountIf(.Columns(c), Activite)
cpteur = cpteur + Effectif1
'determination du nombre de personne suivant l'activté renseigné dans la colonne D si non vide
If table(i, 5) <> "" Then 'If .Cells(i, 5) <> "" Then
Activite = table(i, 5) 'Activite = .Cells(i, 5)
For e = 25 To finlist
If table(e, c) <> NonContinuous Then 'If .Cells(e, c).Borders(xlDiagonalUp).LineStyle = xlContinuous Then
If table(e, c) = Activite Then 'If .Cells(e, c).Value = Activite Then
Nbrediag = Nbrediag + 1
End If
End If
Next e
Effectif2 = WorksheetFunction.CountIf(.Columns(c), Activite)
cpteur = cpteur + Effectif2
End If
'compte le nombre d'absent + les 1/2 journée
If Activite = "Abs" Then
valeur = WorksheetFunction.CountIf(.Columns(c), Activite) + Nbrediag / 2
Else 'Compte le nombre de personne présente et déduit les 1/2 journées
valeur = Effectif1 + Effectif2 - Nbrediag / 2
End If
If valeur <> Int(valeur) Then
.Cells(i, c) = valeur
.Cells(i, c).NumberFormat = "0.0"
End If
'.Columns(c).EntireColumn.AutoFit
Effectif1 = 0
Effectif2 = 0
Nbrediag = 0
valeur = 0
Next i
'Nombre de personne non déterminer par des activités courantes hormis les samedis sans activité (PA)
NbrePA = WorksheetFunction.CountIf(.Range(.Cells(25, c), .Cells(finlist, c)), "PA")
valeur = WorksheetFunction.CountA(.Range(.Cells(25, c), .Cells(finlist, c))) - cpteur - NbrePA
If valeur <> Int(valeur) Then
.Cells(22, c) = valeur
.Cells(22, c).NumberFormat = "0.0"
End If
valeur = 0
cpteur = 0
'.Columns(c).EntireColumn.AutoFit
Next c
.Range(.Cells(1, coldep), .Cells(1, fincol)).EntireColumn.AutoFit
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Duree = Timer - T
MsgBox Duree & " secondes"
End Sub |
