[已解决]求助关于随机取数的代码

快乐童年

VB专家，你好，我有问题要求写在附件里面啦，希望能得到你的帮助

最佳答案

月排行榜 / 总排行榜

mxg825

2012-8-5 16:02

1. Sub 填充数据()
   
2. Dim Temp%, X%, Y%, R%, C%, Arr
   
3. Arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9) '赋10个数值，可随意增减数值个数
   
4. C = UBound(Arr) '数值个数
   
5. For R = 1 To 10 '填充10行（填充总行数）
   
6.     For X = 0 To C '  这个循环是：起【打乱顺序】功能！
   
7.         Y = Int(Rnd * (C + 1)) '随机数 换换位置
   
8.             Temp = Arr(X)
   
9.             Arr(X) = Arr(Y)
   
10.             Arr(Y) = Temp
    
11.     Next
    
12. Range("A" & R).Resize(1, C + 1) = Arr '把打乱后数据 导出填充到单元格
    
13. Next '下一行！
    
14. End Sub
    

复制代码

跳转到最佳答案楼层

mxg825

你这个问题,把生成随机数!
换成 随机填充到单元格!

mxg825

可以另一个高效的方式!

在A-J 先填充 0-9 10个数!

再用随机函数，随机把A-J 列单元格，其他两个单元格进行互换！来实现！

快乐童年

呵呵，可能说的不明确，不过，意思我想大家能看明白吧，应该

mxg825

1. Sub 重排序()
   
2. Dim Temp%, X%, Y%
   
3. For X = 1 To 10
   
4.     Y = Int(Rnd * 10) + 1
   
5.     If X <> Y Then
   
6.         Temp = Cells(1, X)
   
7.         Cells(1, X) = Cells(1, Y)
   
8.         Cells(1, Y) = Temp
   
9.     End If
   
10. Next
    
11. End Sub

复制代码

mxg825

再来一个数组的！

1. Sub 重新排序()
   
2. Dim Temp%, X%, Y%, Arr
   
3. Arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
   
4. For X = 0 To UBound(Arr)
   
5.     Y = Int(Rnd * 10)
   
6.         Temp = Arr(X)
   
7.         Arr(X) = Arr(Y)
   
8.         Arr(Y) = Temp
   
9. Next
   
10. Range("A1:J1") = Arr
    
11. End Sub

复制代码

scsys1

1. Sub sjs()
   
2. Dim a As Integer, b As Integer, c As Integer
   
3. Dim rn As Range
   
4. Application.ScreenUpdating = False
   
5.     With Sheet2
   
6.         For a = 1 To 10
   
7.             For b = 1 To 9
   
8.                 Set rn = .Cells(a, 1).Resize(1, 9)
   
9. 100:
   
10.                 c = WorksheetFunction.Round(Rnd * 9, 0)
    
11.                     If WorksheetFunction.CountIf(rn, c) = 0 Then
    
12.                         .Cells(a, b) = c
    
13.                     Else
    
14.                         GoTo 100
    
15.                     End If
    
16.             Next
    
17.             .Cells(a, 10) = 45 - WorksheetFunction.Sum(rn)
    
18.         Next
    
19.     End With
    
20. MsgBox "已生成，请检查！", 64, "提示"
    
21. Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

快乐童年

此次确实能填充，但是只填充了一行，我想执行一次填入多行。如何弄。快接近，我要的答案啦。在线等

mxg825

1. Sub 填充数据()
   
2. Dim Temp%, X%, Y%, R%, C%, Arr
   
3. Arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9) '赋10个数值，可随意增减数值个数
   
4. C = UBound(Arr) '数值个数
   
5. For R = 1 To 10 '填充10行（填充总行数）
   
6.     For X = 0 To C '  这个循环是：起【打乱顺序】功能！
   
7.         Y = Int(Rnd * (C + 1)) '随机数 换换位置
   
8.             Temp = Arr(X)
   
9.             Arr(X) = Arr(Y)
   
10.             Arr(Y) = Temp
    
11.     Next
    
12. Range("A" & R).Resize(1, C + 1) = Arr '把打乱后数据 导出填充到单元格
    
13. Next '下一行！
    
14. End Sub
    

复制代码

scsys1

快乐童年 发表于 2012-8-5 15:54
此次确实能填充，但是只填充了一行，我想执行一次填入多行。如何弄。快接近，我要的答案啦。在线等

7楼能填充10行，看看吧。