重新 求助 数据编号 已经把实际问题简化

不说实际问题，拿自己抽象过的题目来提问，如果知道了简化题的答案，真的能解决实际问题吗？

'
Option Explicit
'
Sub abc()
　Dim a(1), i, j, d, m, num
　a(0) = Range("a1:e" & [a1].End(xlDown).Row).Value
　a(1) = Range("g2:h" & [g2].End(xlDown).Row).Value
　Set d = CreateObject("scripting.dictionary")
　For i = 2 To UBound(a(0))
　　d(a(0)(i, 1)) = i
　Next
　ReDim b(1 To UBound(a(1)) * 4, 1 To 7), n(UBound(a(0), 2))
　num = Array(0, 0, 8, 4, 16, 16)
　For i = 1 To UBound(a(1))
　　If Not d.exists(a(1)(i, 2)) Then MsgBox a(1)(i, 2): Exit Sub
　　For j = 2 To UBound(a(0), 2)
　　　If a(0)(d(a(1)(i, 2)), j) > 0 Then
　　　　n(j) = n(j) + 1
　　　　m = m + 1
　　　　b(m, 1) = a(1)(i, 1): b(m, 2) = a(1)(i, 2): b(m, 3) = (m - 1) Mod 8 + 1
　　　　b(m, 4) = a(0)(1, j): b(m, 5) = a(0)(1, j) & n(j)
　　　　b(m, 6) = (n(j) - 1) \ num(j) + 1
　　　　b(m, 7) = (n(j) - 1) Mod num(j) + 1
　　　End If
　　Next
　Next
　[j2].Resize(UBound(b), UBound(b, 2)) = b
End Sub