求助大神求救！条件随机取数

'
Option Explicit
'
Sub abc()
　Dim a, i, j, n, p, d
　a = [a1].CurrentRegion.Offset(1).Resize(, 5).Value
　Set d = CreateObject("scripting.dictionary")
　For i = 1 To UBound(a) - 1
　　a(i, 5) = i: a(i, 3) = Empty
　　If Not d.exists(a(i, 1)) Then n = n + 1: d(a(i, 1)) = n
　　a(i, 4) = d(a(i, 1))
　Next
　Call bsort(a, 1, UBound(a) - 1, 1, 5, 4)
　p = 0: n = 0
　For i = 1 To UBound(a) - 1
　　If a(i, 1) <> a(i + 1, 1) Then
　　　Call rand(a, p + 1, i, 1, 5)
　　　n = n + 1
　　　For j = p + 1 To p + 1 + 1
　　　　If j > i Then Exit For
　　　　a(j, 3) = n
　　　Next
　　　p = i
　　End If
　Next
　Call bsort(a, 1, UBound(a) - 1, 1, 5, 5)
　[a2].Resize(UBound(a), 3) = a
End Sub
'
Function bsort(a, first, last, left, right, key)
　Dim i, j, k, t
　For i = first To last - 1
　　For j = first To last + first - 1 - i
　　　If a(j, key) > a(j + 1, key) Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function
'
Function rand(a, first, last, left, right)
　Dim i As Long, j As Long, n As Long, cnt As Long, t
　cnt = last - first + 1
　Randomize
　For i = first To last
　　n = Int(Rnd * cnt)
　　For j = left To right
　　　t = a(i, j): a(i, j) = a(first + n, j): a(first + n, j) = t
　　Next
　Next
End Function