[已解决]随机但指定间距的排序

张雄友

冒泡排序执行一百万次都没有可能。

最佳答案

月排行榜 / 总排行榜

grf1973

2016-6-3 16:00

1. Sub tt()
   
2. 1:
   
3.     arr = Range("b2:b" & [b65536].End(3).Row)
   
4.     ReDim crr(1 To UBound(arr), 1 To 1)
   
5.     n = UBound(arr)      '生成第一个随机数
   
6.     p = Int(Rnd * n + 1)
   
7.     crr(1, 1) = arr(p, 1)
   
8.     arr(p, 1) = arr(n, 1)
   
9.     n = n - 1
   
10.     For i = 2 To UBound(arr)
    
11.         s = 0
    
12. 100:
    
13.         s = s + 1
    
14.         p = Int(Rnd * n + 1)
    
15.         x = arr(p, 1)
    
16.         If Abs(crr(i - 1, 1) - x) <= 7 Then   '不符合条件，重新生成随机数。如果生成次数超过上限，重新运行本程序。
    
17.             If s < 5 * n Then GoTo 100 Else GoTo 1
    
18.         Else
    
19.             crr(i, 1) = x
    
20.             arr(p, 1) = arr(n, 1)
    
21.             n = n - 1
    
22.         End If
    
23.     Next
    
24.     [d2].Resize(UBound(arr)) = crr
    
25. End Sub
    

复制代码

跳转到最佳答案楼层

张雄友

怎么做？

grf1973

1. Sub tt()
   
2. 1:
   
3.     arr = Range("b2:b" & [b65536].End(3).Row)
   
4.     ReDim crr(1 To UBound(arr), 1 To 1)
   
5.     n = UBound(arr)      '生成第一个随机数
   
6.     p = Int(Rnd * n + 1)
   
7.     crr(1, 1) = arr(p, 1)
   
8.     arr(p, 1) = arr(n, 1)
   
9.     n = n - 1
   
10.     For i = 2 To UBound(arr)
    
11.         s = 0
    
12. 100:
    
13.         s = s + 1
    
14.         p = Int(Rnd * n + 1)
    
15.         x = arr(p, 1)
    
16.         If Abs(crr(i - 1, 1) - x) <= 7 Then   '不符合条件，重新生成随机数。如果生成次数超过上限，重新运行本程序。
    
17.             If s < 5 * n Then GoTo 100 Else GoTo 1
    
18.         Else
    
19.             crr(i, 1) = x
    
20.             arr(p, 1) = arr(n, 1)
    
21.             n = n - 1
    
22.         End If
    
23.     Next
    
24.     [d2].Resize(UBound(arr)) = crr
    
25. End Sub
    

复制代码

张雄友

grf1973 发表于 2016-6-3 16:00

第十七句为什么用5而不用其它？？？

grf1973

随便选的，原来选的10.感觉5足够了。

张雄友

grf1973 发表于 2016-6-3 16:07
随便选的，原来选的10.感觉5足够了。

为什么不用冒泡排序就？？？

grf1973

为什么要用？