Option Explicit
Function NoiChuoi(ByVal Rng As Range)
Dim i&, j&, Lr&, k&, N As Date, L As Date, R&
Dim Res()
'Dim Rng As Range ', eRng As Range
With ActiveSheet ' Sheet1
R = Rng.Rows.Count
'Set eRng = .Range("E9:F10")
For i = 1 To R
    N = Rng(i, 2): L = Rng(i, j)
        For j = 2 To 3
            If Rng(i, j) <= N Then N = Rng(i, j)
            If Rng(i, j) >= L Then L = Rng(i, j)
        Next j
Next i
ReDim Res(1 To 1 + L - N, 1 To 3)
If Rng(1, 4) = Empty Or Rng(2, 4) = Empty Then
    Do
        k = k + 1
        Res(k, 1) = k
        Res(k, 2) = N
        For i = 1 To R
            If N >= Rng(i, 2) And N <= Rng(i, 3) Then
                If Res(k, 3) = Empty Then Res(k, 3) = Rng(i, 1) Else Res(k, 3) = Res(k, 3) & ", " & Rng(i, 1)
            End If
        Next i
        N = N + 1
    Loop While N < L + 1
Else
    Do
        k = k + 1
        Res(k, 1) = k
        Res(k, 2) = N
        For i = 1 To R
            If N >= Rng(i, 2) And N <= Rng(i, 3) Then Res(k, 3) = Rng(i, 1): Exit For
        Next i
        N = N + 1
    Loop While N < L + 1
End If
NoiChuoi = Res
End With
End Function