求一个将二列数据随机打乱顺序的vba

CAONI

1、a、b二列分别填有数字。
2、将a、b二列数字首尾合并成一列数据输入到数组中。
3、将数组中的数据位置打乱顺序并依次输出到K5:k10,l5:l10、m5:m10,依次......

谢谢！！！


二列随机.rar (6.79 KB, 下载次数: 16)

2021-2-5 22:39 上传

点击文件名下载附件

yjh_27

自定义函数

CAONI

yjh_27 发表于 2021-2-6 09:57
自定义函数

老师你好，程序经测试满足要求，谢谢！！！

hcm19522

D5:E15=RAND()

K5:Q10 {=IFERROR(INDIRECT(TEXT(RIGHT(SMALL(RANK($D$5:$E$15,$D:$E)/1%%+ROW($5:$15)/1%+{1,2},COLUMN(A1)*6-6+ROW(A1)),4),"!R0C00"),),"")

K13:Q18{=IFERROR(INDIRECT(TEXT(SMALL(IF((COUNTIF($J$13:J$18,$A$5:$B$15)=0)*(COUNTIF(K$12:K12,$A$5:$B$15)=0),ROW($5:$15)/1%+{1,2}),RANDBETWEEN(1,23-ROW(A1)-COLUMN(A1)*6+6)),"!R0C00"),),"")

T5{=AND(COUNTIF(K5:Q10,A5:B15)=1)

T13{=AND(COUNTIF(K13:Q18,A5:B15)=1)

CAONI

yjh_27 发表于 2021-2-6 09:57
自定义函数

老师你好，我在a5:d1000004区域中填满数据400万，每次运行程序后结果再填到a5:d1000004，但每次结果都会少100-200行数（个数据），采用按钮为：
Sub 条件1_按钮36_Click()
[a5:d1000004] = ArrRnd2(Range("a5:d1000004"), 1000004, 4, 0, , 1)
End Sub

yjh_27

CAONI 发表于 2021-2-7 11:55
老师你好，我在a5:d1000004区域中填满数据400万，每次运行程序后结果再填到a5:d1000004，但每次结果都会 ...

[a5:d1000004] = ArrRnd2(Range("a5:d1000004"), 1000000, 4, 0, , 1)

参数2是行数，不是行号。
再有问题上传问题附件

CAONI

yjh_27 发表于 2021-2-7 13:41
[a5:d1000004] = ArrRnd2(Range("a5:d1000004"), 1000000, 4, 0, , 1)

参数2是行数，不是行号。

谢谢老师指点！！！

i3myself

yjh_27 发表于 2021-2-7 13:41
[a5:d1000004] = ArrRnd2(Range("a5:d1000004"), 1000000, 4, 0, , 1)

参数2是行数，不是行号。

您好，能帮忙看下我的问题吗，冒昧打扰，实在很困惑，好几天了也没试出来什么结果 http://club.excelhome.net/thread-1574296-1-1.html

grf1973

1. Sub 随机()
   
2.     arr = [a5:b15]   '源数据
   
3.     ReDim brr(1 To UBound(arr) * UBound(arr, 2))   '转成一维数组，便于随机取数
   
4.     For i = 1 To UBound(arr)
   
5.         For j = 1 To UBound(arr, 2)
   
6.             n = n + 1
   
7.             brr(n) = arr(i, j)
   
8.         Next
   
9.     Next
   
10.     p = n
    
11.     r = 6      '结果显示成6行
    
12.     ReDim crr(1 To r, 1 To Int(r / 6) + 1)   '结果显示数组（6行）
    
13.     For j = 1 To UBound(crr, 2)
    
14.         If p = 0 Then Exit For     '取光后退出循环
    
15.         For i = 1 To 6
    
16.             If p = 0 Then Exit For  '取光后退出循环
    
17.             t = Int(p * Rnd) + 1      '随机位置
    
18.             crr(i, j) = brr(t)   '取数
    
19.             brr(t) = brr(p)       '取数位置用最末数代替
    
20.             p = p - 1      '最末位置前移
    
21.         Next
    
22.     Next
    
23.     [k13].Resize(6, j) = crr       '显示结果
    
24. End Sub
    

复制代码

grf1973

简化一点

1. Sub 随机()
   
2.     arr = [a5:b15]   '源数据
   
3.     ReDim brr(1 To UBound(arr) * UBound(arr, 2))   '转成一维数组，便于随机取数
   
4.     For i = 1 To UBound(arr)
   
5.         For j = 1 To UBound(arr, 2)
   
6.             n = n + 1
   
7.             brr(n) = arr(i, j)
   
8.         Next
   
9.     Next
   
10.     p = n
    
11.     r = 8      '结果显示成6行
    
12.     ReDim crr(1 To r, 1 To Int(n / r) + 1)   '结果显示数组（r行）
    
13.     For p = n To 1 Step -1
    
14.         pp = n - p + 1
    
15.         j = Int(pp / r - 0.1) + 1
    
16.         i = (pp - 1) Mod r + 1
    
17.         t = Int(p * Rnd) + 1      '随机位置
    
18.         crr(i, j) = brr(t)   '取数
    
19.         brr(t) = brr(p)       '取数位置用最末数代替
    
20.     Next
    
21.     [k13].Resize(r, j) = crr       '显示结果
    
22. End Sub

复制代码