Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, s
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---listes dans la feuille jour---
tablo = Sheets("jour").UsedRange.Resize(, 4) 'matrice, plus rapide
For i = 2 To UBound(tablo)
x = CStr(tablo(i, 1))
If x <> "" Then d(x) = tablo(i, 3) & Chr(1) & tablo(i, 4)
Next
If d.Count = 0 Then Exit Sub
'---tableau des résultats---
tablo = UsedRange.Resize(, 5) 'matrice, plus rapide
For i = 2 To UBound(tablo)
x = CStr(tablo(i, 1))
If d.exists(x) Then
s = Split(d(x), Chr(1))
If IsNumeric(s(0)) Then tablo(i, 4) = CDbl(s(0)) Else tablo(i, 4) = s(0)
If IsNumeric(s(1)) Then tablo(i, 5) = CDbl(s(1)) Else tablo(i, 5) = s(0)
End If
Next
'---restitution---
UsedRange.Resize(, 5) = tablo
End Sub