行随机打乱

gwjkkkkk

Option Explicit
Sub test2()
    Dim br, i&
    br = [A1].CurrentRegion.Value
    Call arrGetRnd2(br)
    [E1].Resize(UBound(br), UBound(br, 2)) = br
End Sub
Function arrGetRnd2(ByRef ar, Optional ByVal isCol As Boolean)
    Dim xNum&, i&, j&, m&, n&, vTemp
   
    Randomize
    m = UBound(ar): n = UBound(ar, 2)
    If isCol Then vTemp = m: m = n: n = vTemp
    For i = 1 To m
        xNum = Int((m - i + 1) * Rnd() + i)
        For j = 1 To n
            If isCol Then
                vTemp = ar(j, xNum): ar(j, xNum) = ar(j, i): ar(j, i) = vTemp
            Else
                vTemp = ar(xNum, j): ar(xNum, j) = ar(i, j): ar(i, j) = vTemp
            End If
        Next
    Next
End Function

gwjkkkkk

。。。。。。。。。。。。

dong130

gwjkkkkk 发表于 2024-8-27 18:32
。。。。。。。。。。。。

厉害的，但还这个B列内容一样的绑一起，一起随机换行，就是他们一直是绑一起跟其他不同内容的打乱

chxw68

dong130 发表于 2024-8-27 18:30
厉害，感谢感谢，利用辅助列排序是指A列的数字吗

是在最后增加一列，填写随机数，排完序后就删除了。

dong130

chxw68 发表于 2024-8-27 18:44
是在最后增加一列，填写随机数，排完序后就删除了。

明白了谢谢

今铭昔

无关岁月

1. Sub 按钮1_Click()
   
2. Dim d, arr, i, s, t, j, k
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a2:d" & [a2].End(4).Row)
   
5. For i = 1 To UBound(arr)
   
6.     s = arr(i, 2)
   
7.     If Not d.exists(s) Then
   
8.         d(s) = Rnd()
   
9.     End If
   
10.     arr(i, 4) = d(s)
    
11. Next
    
12. For i = 1 To UBound(arr)
    
13.     For j = i + 1 To UBound(arr)
    
14.         If arr(i, 4) > arr(j, 4) Then
    
15.             For k = 1 To 4
    
16.                 t = arr(j, k): arr(j, k) = arr(i, k): arr(i, k) = t
    
17.             Next
    
18.         End If
    
19.     Next
    
20. Next
    
21. [a18].Resize(UBound(arr), UBound(arr, 2) - 1) = arr
    
22. End Sub

复制代码