|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub rndjoin()
- Dim dis As Object, rndis As Integer, mydis As Variant
- Dim ar1 As Variant, ar2 As Variant, ar3 As Variant
- Dim r1 As Integer, r2 As Integer, r3 As Integer
- Dim rrnd As Integer, arr As Variant, i As Integer, j As Integer
- Set dis = CreateObject("scripting.dictionary")
- aro = [a2:c2].Value
- ar1 = Split(StrConv(aro(1, 1), vbNarrow), ",")
- ar2 = Split(StrConv(aro(1, 2), vbNarrow), ",")
- ar3 = Split(StrConv(aro(1, 3), vbNarrow), ",")
- For r1 = 0 To UBound(ar1)
- For r2 = 0 To UBound(ar2)
- For r3 = 0 To UBound(ar3)
- dis(ar1(r1) & ar2(r2) & ar3(r3)) = ""
- Next r3
- Next r2
- Next r1
- ReDim arr(1 To dis.Count, 1 To 2)
- Do While dis.Count
- mydis = dis.keys
- rndis = Int(dis.Count * Rnd())
- j = j + 1
- arr(j, 1) = j
- arr(j, 2) = mydis(rndis)
- dis.Remove (arr(j, 2))
- Loop
- Range("F:G").ClearContents
- Range("f1:G1") = [{"序号","随机合并"}]
- Range("f2").Resize(UBound(arr), 2) = arr
- End Sub
复制代码 |
|