多个整数随机排列问题

cl02010201

请教各位，1到24个整数按顺序列出，第1个是1，第2个是2，……想要对它们进行随机排序，且随机后的每个数字不能在原来的位置上，如1不能在第1个，2不能在第2个……，随机排序应该好做，但如何确保不在原来的位置上？

ynzsvt

1. Sub 随机数不在本位()
   
2. Dim i&, Arr(1 To 24), R&, D As Object
   
3. Set D = CreateObject("Scripting.Dictionary")
   
4. 
   
5. i = 1
   
6. Do
   
7.   R = Int(Rnd() * 24 + 1)
   
8.   If Not D.Exists(R) And R <> i Then
   
9.    D(R) = "": Arr(i) = R: i = i + 1
   
10.   End If
    
11. Loop Until i = 24
    
12. 
    
13. For i = 1 To 24
    
14.   If Not D.Exists(i) Then Exit For
    
15. Next
    
16. If i <> 24 Then
    
17.   Arr(24) = i
    
18. Else
    
19.   R = Int(Rnd() * 23 + 1): Arr(i) = R: Arr(R) = 24
    
20. End If
    
21. 
    
22. Cells(1, 1).Resize(1, 24) = Arr
    
23. Set D = Nothing
    
24. End Sub

复制代码

kevinchengcw

不重复的12组随机2个位置互换即可

笨鸟飞不高

清风竹-

1. Sub 随机选数()
   
2. Dim d
   
3. On Error Resume Next
   
4. Set d = CreateObject("scripting.dictionary")
   
5.     Do
   
6.     ss = Application.Round(Rnd * 23 + 1, 0)
   
7.       d.Add ss, n
   
8.     Loop Until d.Count = 24
   
9.    k = d.keys
   
10.    For i = 0 To 20
    
11.       If k(i) = i + 1 Then
    
12.           s = k(i)
    
13.           k(i) = k(i + 1)
    
14.           k(i + 1) = s
    
15.       End If
    
16.    Next
    
17.    For i = 23 To 20 Step -1
    
18.       If k(i) = i + 1 Then
    
19.           s = k(i)
    
20.           k(i) = k(i - 1)
    
21.           k(i - 1) = s
    
22.       End If
    
23.    Next
    
24.    
    
25. [b2:b25] = Application.Transpose(k)
    
26. Set d = Nothing
    
27. End Sub
    
28. 
    

复制代码

songshihai

随机排序且不在自己位置上

大灰狼1976

不需要字典吧

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

复制代码

Qs18

1. Sub qs()
   
2.     Dim arr(1 To 20) As Integer
   
3.     Dim i As Integer
   
4.     Dim j As Integer
   
5.     Dim temp As Integer
   
6.     ' 初始化数组
   
7.     For i = 1 To 20
   
8.         arr(i) = i
   
9.     Next i
   
10.    
    
11.     ' 随机排列数组
    
12.     For i = 1 To 20
    
13.         j = i + Int((20 - i + 1) * Rnd)
    
14.         ' 交换元素
    
15.         temp = arr(i)
    
16.         arr(i) = arr(j)
    
17.         arr(j) = temp
    
18.     Next i
    
19.    
    
20.     ' 输出结果
    
21.     For i = 1 To 20
    
22.         Cells(i, 1).Value = arr(i)
    
23.     Next i
    
24. End Sub

复制代码

Qs18

试试。。。。。。。。。。

ynzsvt

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

24阶乘分之一的概率会死机吧。