用VBA 按条件提取两表中二级明细会计科目名的不重复记录到表三

wnccmxm

求助  用VBA 按条件提取两表中二级明细会计科目名的不重复记录到表三

根据蓝桥玄霜 老师的指点，问题已完满得到解决，再次感谢蓝桥玄霜 老师。
下面是表一、表二中的明细子目录名，报不重复记录后到表四的代码。
希望更多的和我相同的初学者，举一返三，推敲学习，理解领会。

Sub symx()
Dim Krr, i&, d, Lrr, t, x$, y$, r%, Krr1()
Set d = CreateObject("Scripting.Dictionary")
Sheet3.Activate
[d4:d500].ClearContents
Krr = Sheet5.[a1].CurrentRegion
For i = 2 To UBound(Krr)
    x = Krr(i, 6): y = Krr(i, 7)
    If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")
    d(x)(y) = y
Next
Lrr = Sheet3.[a1].CurrentRegion
For i = 4 To UBound(Lrr)
    If Lrr(i, 2) = "" Then
        r = r + 1
        ReDim Preserve Krr1(1 To r)
        Krr1(r) = i
    End If
Next
For i = 1 To r
    If d.exists(Lrr(Krr1(i), 3)) Then
        t = d(Lrr(Krr1(i), 3)).keys
        If UBound(t) > 0 Then
            Cells(Krr1(i) + 1, 4).Resize(UBound(t) + 1) = Application.Transpose(t)
        Else
            Cells(Krr1(i) + 1, 4) = t(0)
        End If
    End If
Next
End Sub

wnccmxm

蓝桥老师，原帮我编写的提取二级科目名称，现在又遇到新问题，帮我修改一下代码，同时提取三级科目名称。附件传上来。

wnccmxm

呵呵，蓝桥老师不理了，该怎么办？