[已解决]VBA求助 我的这个随机排序 点击后 没有反应 代码应该怎么修改

wg68241064

思路：
    先为每个考号添加一个各不相同的随机数字（此表为滚动存入的），再把考生按这些随机数按升序的顺序排列
排列后 生成新的序号(1到有数据的行 结束)（补充：编排结果输出到 随机编号)

代码：
Private Sub 随机编号()Dim arr1(), i As Integer, i1 As Integer, n As Integer, j As Integer, y As Integer, t As Boolean, temp1i = Sheets("提取库").Range("a65536").End(xlUp).RowIf i < 2 Then Exit Subarr1 = Sheets("提取库").Range("a2:e" & i).Valuei = 1Randomize    Do While i <= UBound(arr1)       Do        n = Int((UBound(arr1) * Rnd) + 1)       Loop While n < i       For j = 1 To 5          temp1 = arr1(i, j)          arr1(i, j) = arr1(n, j)          arr1(n, j) = temp1       Next       arr1(i, 1) = i       i = i + 1    LoopFor i = 1 To 2   For j = 1 To 288      n = (i - 1) * 288 + j      If n > UBound(arr1) Then        Exit For        Exit For      End If      arr1(n, 1) = j   Next jNext iSheets("随机编号").Range("a3").Resize(UBound(arr1), 5) = arr1End Sub

最佳答案

月排行榜 / 总排行榜

香川群子

2012-2-7 08:55

如果要在VBA内存数组中进行随机排序，那么代码如下：

1. Sub Macro2()
   
2.     With Sheets(1)
   
3.         n = .[a65536].End(3).Row - 2
   
4.         arr = .[a3].Resize(n, 8)
   
5.     End With
   
6.     x = WorksheetFunction.Transpose(Application.Index(arr, , 1))
   
7.     '获取列序号（或任何作为随机排序依据的列的内容）压入一维数组用来随机
   
8.     Call GetRnd(x, n) '调用经典随机洗牌过程 进行高效不重复随机排序
   
9.    
   
10.     brr = arr
    
11.     For i = 1 To n
    
12.         brr(i, 1) = i 'brr数组第1列生成新的序号
    
13.         For j = 2 To 8
    
14.             brr(i, j) = arr(x(i), j) '把arr数组内容按新的随机排序值重新整理数据到brr数组
    
15.         Next
    
16.     Next
    
17.    
    
18.     Sheets(2).[a3].Resize(n, 8) = brr '在表2输出结果
    
19.     Sheets(2).Activate
    
20.    
    
21. End Sub
    
22. 
    
23. '经典随机洗牌过程代码，以后可以在别的代码中使用
    
24. '因此，我把它单独列出，而不是放在过程中。
    
25. Sub GetRnd(arr, n)
    
26.     Randomize
    
27.     For i = 1 To n
    
28.         r = Int(Rnd() * (n - i + 1)) + i
    
29.         t = arr(r): arr(r) = arr(i): arr(i) = t
    
30.     Next
    
31. End Sub
    

复制代码

跳转到最佳答案楼层

zjdh

直接用按钮运行你的程序即可，何必用窗体？
另：你的附件有病毒！！

wg68241064

zjdh 发表于 2012-2-6 17:46
直接用按钮运行你的程序即可，何必用窗体？
另：你的附件有病毒！！

应该不是病毒 是宏的事吧

香川群子

如果有效利用Excel自身功能，进行随机排序的话，代码如下：

1. 
   
2. Sub Macro1()
   
3.     rw = [a65536].End(3).Row '获取最大行序号
   
4.     [a3].Resize(rw - 2).FormulaR1C1 = "=RAND()" 'A列填入随机公式取值
   
5.     [a3].Resize(rw - 2, 8).Sort Key1:=[a3], Order1:=xlAscending, Header:=xlNo '按随机值排序
   
6.     [a3] = 1:    [a3].Resize(rw - 2).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1 ‘自动填充
   
7. End Sub
   

复制代码

香川群子

如果要在VBA内存数组中进行随机排序，那么代码如下：

1. Sub Macro2()
   
2.     With Sheets(1)
   
3.         n = .[a65536].End(3).Row - 2
   
4.         arr = .[a3].Resize(n, 8)
   
5.     End With
   
6.     x = WorksheetFunction.Transpose(Application.Index(arr, , 1))
   
7.     '获取列序号（或任何作为随机排序依据的列的内容）压入一维数组用来随机
   
8.     Call GetRnd(x, n) '调用经典随机洗牌过程 进行高效不重复随机排序
   
9.    
   
10.     brr = arr
    
11.     For i = 1 To n
    
12.         brr(i, 1) = i 'brr数组第1列生成新的序号
    
13.         For j = 2 To 8
    
14.             brr(i, j) = arr(x(i), j) '把arr数组内容按新的随机排序值重新整理数据到brr数组
    
15.         Next
    
16.     Next
    
17.    
    
18.     Sheets(2).[a3].Resize(n, 8) = brr '在表2输出结果
    
19.     Sheets(2).Activate
    
20.    
    
21. End Sub
    
22. 
    
23. '经典随机洗牌过程代码，以后可以在别的代码中使用
    
24. '因此，我把它单独列出，而不是放在过程中。
    
25. Sub GetRnd(arr, n)
    
26.     Randomize
    
27.     For i = 1 To n
    
28.         r = Int(Rnd() * (n - i + 1)) + i
    
29.         t = arr(r): arr(r) = arr(i): arr(i) = t
    
30.     Next
    
31. End Sub
    

复制代码

wg68241064

香川群子 发表于 2012-2-7 08:55
如果要在VBA内存数组中进行随机排序，那么代码如下：

那我要是存入另一个SHEET里呢 加行什么代码?

wg68241064

香川群子 发表于 2012-2-7 08:55
如果要在VBA内存数组中进行随机排序，那么代码如下：

要保持两表样式一样  就是 新表是随机排序后 又按顺序填的序号

wg68241064

香川群子 发表于 2012-2-7 08:01
如果有效利用Excel自身功能，进行随机排序的话，代码如下：

还有个 要求 新生成的表要有边框的

wg68241064

香川群子 发表于 2012-2-7 08:55
如果要在VBA内存数组中进行随机排序，那么代码如下：

• Sheets(2).[a3].Resize(n, 8) = brr '在表2输出结果
• Sheets(2).Activate
  

   在这个代码上 加什么 输出的结果 是带表格的啊？

香川群子

wg68241064 发表于 2012-2-7 12:54

Sheets(2).[a3].Resize(n, 8) = brr '在表2输出结果

Sheets(2).Activate
   在这 ...

录制宏就可以知道如何画表格的格子线。

算啦，直接帮你整理好：

1. 
   
2.     With Selection 'Draw Line
   
3.         .Borders(xlEdgeLeft).LineStyle = xlContinuous
   
4.         .Borders(xlEdgeTop).LineStyle = xlContinuous
   
5.         .Borders(xlEdgeBottom).LineStyle = xlContinuous
   
6.         .Borders(xlEdgeRight).LineStyle = xlContinuous
   
7.         .Borders(xlInsideVertical).LineStyle = xlContinuous
   
8.         .Borders(xlInsideHorizontal).LineStyle = xlContinuous
   
9.     End With
   

复制代码