Public d1 As Object, d2 As Object 'mémorise les variables
Function ENP$(r As Range)
Application.Volatile
Dim x$, a, b, annee#, i&
If d1 Is Nothing Then Dictionnaire
x = r(1) & r(2) & r(3) 'colonnes B C D
a = Split(d1(x))
b = Split(d2(x))
tri a, b, 0, UBound(a)
annee = Val(r(4))
For i = 0 To UBound(a)
If Val(a(i)) = annee Then
If i = 0 Then
ENP = "*"
ElseIf b(i) = b(i - 1) Then
ENP = "E"
Else
ENP = IIf(LCase(r(1)) = "dépenses" And Val(b(i)) < Val(b(i - 1)) Or LCase(r(1)) <> "dépenses" And Val(b(i)) > Val(b(i - 1)), "P", "N")
End If
Exit For
End If
Next
End Function
Sub Dictionnaire()
Dim tablo, i, x$
tablo = [A1].CurrentRegion.Resize(, 6)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare
For i = 2 To UBound(tablo)
x = tablo(i, 2) & tablo(i, 3) & tablo(i, 4) 'colonnes B C D
d1(x) = Trim(d1(x) & " " & Val(tablo(i, 5)))
d2(x) = Trim(d2(x) & " " & Val(Replace(tablo(i, 6), ",", ".")))
Next
End Sub
Sub tri(a, b, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
temp = b(g): b(g) = b(d): b(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub