多个整数随机排列问题

大灰狼1976

ynzsvt 发表于 2024-9-12 14:33
24阶乘分之一的概率会死机吧。

是的，有末位陷阱，没做防错处理

chenjx80

大灰狼1976 发表于 2024-9-12 13:06
不需要字典吧

当位置1～23刚好排完数字1～23时，剩下数字24排在位置24，此时便会进入死循环。

大灰狼1976

chenjx80 发表于 2024-9-12 15:42
当位置1～23刚好排完数字1～23时，剩下数字24排在位置24，此时便会进入死循环。

嗯，我上面说了。解决也简单的，懒得写

大灰狼1976

就再写一个吧，末位死循环时懒得做调整处理，直接从头再来。

1. Sub test()
   
2. Dim i&, n&, arr(1 To 24, 0)
   
3. For i = 1 To 24
   
4.   If i = 24 And arr(24, 0) = "" Then Exit For
   
5.   n = Int(Rnd() * 24) + 1
   
6.   If arr(n, 0) = "" And n <> i Then arr(n, 0) = i Else i = i - 1
   
7. Next i
   
8. If i = 24 Then test
   
9. [a1:a24] = arr
   
10. End Sub

复制代码

chenjx80

供参考：

1. Public Sub RandArray()
   
2.    Const MAXNUMBER As Long = 24
   
3.    Dim arr(1 To MAXNUMBER) As Long
   
4.    Dim pos As Long, randPos As Long, tmp As Long
   
5.    
   
6.    For pos = 1 To MAXNUMBER: arr(pos) = pos: Next
   
7.    Randomize
   
8.    pos = 1
   
9.    Do
   
10.       randPos = Int(Rnd() * MAXNUMBER) + 1
    
11.       If pos <> arr(randPos) And randPos <> arr(pos) Then
    
12.          tmp = arr(pos)
    
13.          arr(pos) = arr(randPos)
    
14.          arr(randPos) = tmp
    
15.          
    
16.          pos = pos + 1
    
17.          If pos > MAXNUMBER Then Exit Do
    
18.       End If
    
19.    Loop
    
20.    
    
21.    Range("A1:A24").Value = WorksheetFunction.Transpose(arr)
    
22. End Sub

复制代码

kyxfyzg

1. Sub test()
   
2. Dim arr(1 To 24), brr
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 1 To 24
   
5.     d(i) = i
   
6. Next i
   
7. For j = 1 To 24
   
8. brr = d.keys
   
9. 100:
   
10.     h = WorksheetFunction.RandBetween(1, UBound(brr) + 1)
    
11.     If d(brr(h - 1)) = j Then GoTo 100
    
12.     arr(j) = brr(h - 1)
    
13.     d.Remove (brr(h - 1))
    
14. Next j
    
15. Range("a1").Resize(UBound(arr), 1) = WorksheetFunction.Transpose(arr)
    
16. End Sub

复制代码

gwjkkkkk

Option Explicit
Sub test1()
    Dim ar, i&, n&, xNum&, vTemp
    ReDim ar(1 To 24, 0)
   
    For i = 1 To UBound(ar)
        ar(i, 0) = i
    Next i
    n = UBound(ar)
    For i = 1 To UBound(ar) - 1
        Do Until ar(i, 0) <> i
            xNum = Int((n - i + 1) * Rnd() + i)
            vTemp = ar(xNum, 0): ar(xNum, 0) = ar(i, 0): ar(i, 0) = vTemp
        Loop
    Next
   
    [A1].Resize(UBound(ar)) = ar
End Sub

sunya_0529

WPS中的JSA练习一下——

cl02010201

ynzsvt 发表于 2024-9-12 07:39

感谢，这个可以用的

cl02010201

kevinchengcw 发表于 2024-9-12 09:19
不重复的12组随机2个位置互换即可

很好的思路，感谢回复