求助大佬 按序号简述填充对应的行

忘了上次看的一个老贴
是年限2006，2008-2013，2014，...
大致这样，谁用FREQUENCY解决的100多字符公式，跟这个很接近

'假设A列序号无重复，不过可以无序，行列数不限
Option Explicit
Sub abc()
　Dim a, i, j, k, d, t(1), m, n
　a = Range("a3:a" & [a2].End(xlDown).Row).Value
　Set d = CreateObject("scripting.dictionary")
　For i = 1 To UBound(a)
　　If d.exists(d(a(i, 1))) Then MsgBox d(a(i, 1)): Exit Sub
　　d(a(i, 1)) = i
　Next
　a = [b1].Resize(, [b1].End(xlToRight).Column - 1).Value
　ReDim b(1 To d.Count, 1 To UBound(a, 2))
　For j = 1 To UBound(a, 2)
　　a(1, j) = Mid((Left(a(1, j), Len(a(1, j)) - 1)), 2)
　　t(0) = Split(Replace(a(1, j), Space(1), vbNullString), ",")
　　For i = 0 To UBound(t(0))
　　　t(1) = Split(t(0)(i), "-")
　　　m = t(1)(0)
　　　If UBound(t(1)) = 0 Then n = t(1)(0) Else n = t(1)(1)
　　　For k = m To n
　　　　If d.exists(k) Then b(d(k), j) = "及格" Else MsgBox k: Exit Sub
　　　Next
　　Next
　Next
　[b3].Resize(UBound(b), UBound(b, 2)) = b
End Sub