求助帖，大神瞧瞧

'假设A列有序
Option Explicit
Sub abc()
　Dim a(1), i, j, d, t
　a(0) = Range("a1:b" & [a1].End(xlDown).Row + 1).Value
　Set d = CreateObject("scripting.dictionary")
　For i = 1 To UBound(a(0)) - 1
　　If a(0)(i, 1) <> a(0)(i + 1, 1) Then
　　　d(a(0)(i, 1)) = Array(j + 1, i)
　　　j = i
　　End If
　Next
　a(1) = Range("e1:e" & [e1].End(xlDown).Row).Value
　ReDim b(1 To UBound(a(1)), 1 To 1)
　Randomize
　For i = 1 To UBound(a(1))
　　If d.exists(a(1)(i, 1)) Then
　　　t = d(a(1)(i, 1))
　　　b(i, 1) = a(0)(t(0) + Int(Rnd * (t(1) - t(0) + 1)), 2)
　　End If
　Next
　[f1].Resize(UBound(b)) = b
End Sub