求助小白求助啊

'姓名按拼音有序后再调整，当前列是不能有重复姓名的，否则需要修改。
Option Explicit
Sub abc()
　Dim a, b, i, j, t, d
　Set d = CreateObject("scripting.dictionary")
　a = [a1].CurrentRegion.Offset(1).Value
　If UBound(a, 2) Mod 2 Then MsgBox "!": Exit Sub
　For j = 1 To UBound(a, 2) Step 2
　　For i = 1 To UBound(a) - 1
　　　If Len(a(i, j)) Then d(a(i, j)) = 1
　　Next
　Next
　b = d.keys: d.RemoveAll
　For i = 0 To UBound(b) - 1
　　For j = i + 1 To UBound(b)
　　　　If StrComp(b(i), b(j), vbTextCompare) = 1 Then
　　　　t = b(i): b(i) = b(j): b(j) = t
　　　　End If
　　Next
　　d(b(i)) = i + 1
　Next
　d(b(i)) = i + 1
　ReDim b(1 To UBound(a) * UBound(a, 2) / 2, 1 To UBound(a, 2))
　For j = 1 To UBound(a, 2) Step 2
　　For i = 1 To UBound(a) - 1
　　　If d.exists(a(i, j)) Then
　　　　b(d(a(i, j)), j) = a(i, j)
　　　　b(d(a(i, j)), j + 1) = a(i, j + 1)
　　　End If
　　Next
　Next
　[a2].Offset(, UBound(a, 2) + 1).Resize(UBound(b), UBound(b, 2)) = b
End Sub