Function Phrase$(nom, dat1, dat2)
Application.Volatile
Dim c As Range, col%, t, nombre As Object, debut As Object, fin As Object, samedi As Object
Dim i&, dat, x$, a, b1, b2, b3, b4, f$
With Sheets("calendrier").UsedRange
Set c = .Find(nom, , xlValues, xlWhole)
If nom = "" Or c Is Nothing Or Not IsDate(dat1) Or Not IsDate(dat2) Then Exit Function
col = c.Column - .Column + 1
t = .Resize(, col) 'tableau VBA, plus rapide
End With
Set nombre = CreateObject("Scripting.Dictionary"): nombre.CompareMode = vbTextCompare 'la casse est ignorée
Set debut = CreateObject("Scripting.Dictionary"): debut.CompareMode = vbTextCompare
Set fin = CreateObject("Scripting.Dictionary"): fin.CompareMode = vbTextCompare
Set samedi = CreateObject("Scripting.Dictionary"): samedi.CompareMode = vbTextCompare
For i = 1 To UBound(t)
dat = t(i, 1)
If IsDate(dat) Then
If dat >= dat1 And dat <= dat2 Then
x = CStr(t(i, col))
If x <> "" Then
If Not nombre.exists(x) Then debut(x) = dat
nombre(x) = nombre(x) + 1
fin(x) = dat
samedi(x) = samedi(x) - (Weekday(dat) = 7)
End If
End If
End If
Next
If nombre.Count = 0 Then Exit Function
a = nombre.keys: b1 = nombre.items: b2 = debut.items: b3 = fin.items: b4 = samedi.items
f = "d mmmm yyyy"
For i = 0 To nombre.Count - 1
Phrase = Phrase & ", " & b1(i) & " " & a(i) & " du " & Format(b2(i), f) & " au " & Format(b3(i), f) & _
IIf(b4(i), " dont " & b4(i) & " samedi" & IIf(b4(i) > 1, "s", ""), "")
Next
Phrase = Mid(Phrase, 3)
End Function
