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
|
Function mcumul(plage As Range, typecum As String, an As Integer, periode As Byte) As Double
Dim boucle As Variant
Dim clef As String
Dim col As Integer
Dim deb As Variant
Dim fin As Variant
Dim macoll As New Collection
Dim premjour As Variant
Dim derjour As Variant
Dim tempo As Double
Dim nbcoll As Long
nbcoll = 0
Select Case typecum
Case "m"
If periode < 1 Or periode > 12 Then
MsgBox ("mois non valide")
Exit Function
End If
premjour = CLng(DateSerial(an, periode, 1))
derjour = CLng(DateSerial(an, periode + 1, 0))
Case "s"
If periode < 1 Or periode > 53 Then
MsgBox ("semaine non valide")
Exit Function
End If
premjour = (DateSerial(an, 1, 1) + ((periode - 2) * 7))
For boucle = 1 To 16
premjour = CLng(premjour) + 1
If Val(Format(premjour, "ww", 2, vbFirstFourDays)) = periode Then Exit For
Next boucle
premjour = CLng(premjour)
derjour = premjour + 6
Case Else
MsgBox ("type période non valide")
Exit Function
End Select
For Each boucle In plage
col = col + 1
Select Case col Mod 3
Case 1
clef = boucle.Value
Case 2
clef = clef & Format(boucle.Value, "yyyymmdd")
deb = boucle.Value
Case 0
clef = clef & Format(boucle.Value, "yyyymmdd")
fin = boucle.Value
' verif doublon
On Error Resume Next
macoll.Add Item:=1, key:=clef
If macoll.Count > nbcoll Then
' calcul
nbcoll = nbcoll + 1
If fin < deb Then
MsgBox ("donnée non valide pour " & clef)
Exit Function
End If
tempo = tempo + Application.WorksheetFunction.Max(Application.WorksheetFunction.Min(derjour, fin) - Application.WorksheetFunction.Max(premjour, deb) + 1, 0)
End If
End Select
Next boucle
mcumul = tempo
Set macoll = Nothing
End Function |
[formule] ttal des jrs d'une mê semaine liés à +ieurs libellés identiques d'1 colonne
Répondre avec citation
Partager