Sub Taches()
Dim F As Worksheet, coltask%, coldat%, colparent%, tablo, resu(), d1 As Object, d2 As Object, i&, x$, n&, y$, s, j&, lig&
Set F = Sheets("Tâches " & IIf([G1] = 1, "externes", "internes"))
coltask = 3 - [G1] '2 et 1
coldat = 10 - [G1] '9 et 8
colparent = IIf([G1] = 1, 1, 12)
F.UsedRange.Sort F.Columns(coldat), xlAscending, Header:=xlYes 'tri sur les dates
tablo = F.UsedRange.Resize(, 12) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 5)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
'---colonnes 1 2 3 des résultats---
For i = 2 To UBound(tablo)
x = CStr(tablo(i, coltask))
If Not d1.exists(x) Then
n = n + 1
d1(x) = ""
y = CStr(tablo(i, colparent))
d2(y) = d2(y) & Chr(1) & n 'mémorise tous les numéros de ligne
resu(n, 1) = x
resu(n, 2) = tablo(i, colparent)
resu(n, 3) = tablo(i, coldat)
End If
Next
If d1.Count = 0 Then GoTo 1 'si le tableau est vide
'---colonnes 4 et 5 des résultats---
tablo = Sheets("Incidents").UsedRange.Resize(, 9) 'matrice, plus rapide
For i = 2 To UBound(tablo)
x = CStr(tablo(i, 1))
If d2.exists(x) Then
s = Split(d2(x), Chr(1))
For j = 1 To UBound(s)
lig = s(j) 'n° de ligne mémorisé
resu(lig, 4) = tablo(i, 9) '2ème date
resu(lig, 5) = resu(lig, 3) - resu(lig, 4)
Next
d2.Remove x
End If
Next
'---restitution---
[A2].Resize(n, 5) = resu
1 Range("A" & n + 2 & ":E" & Rows.Count).ClearContents 'RAZ en dessous
End Sub