[已解决]请老师们修改一下代码

米特峰

用VBA随机数字不能重复，，而我这个代码竟然重复了，请老师们给予指教
随机不重复5数.zip (220.42 KB, 下载次数: 6)

2014-12-8 12:24 上传

点击文件名下载附件

1. Sub 随机()
   
2. Range("a1:a10000").NumberFormatLocal = "00000"
   
3. For i = 1 To 10000
   
4.   Cells(i, 1) = "": s = Int(Rnd * 10)
   
5.   For x = 1 To 5
   
6.     While InStr(Cells(i, 1), s)
   
7.       s = Int(Rnd * 10)
   
8.     Wend
   
9.     Cells(i, 1) = Cells(i, 1) & s
   
10.   Next
    
11. Next
    
12. End Sub

复制代码

最佳答案

月排行榜 / 总排行榜

qh8600

2014-12-8 13:29

米特峰 发表于 2014-12-8 13:20
代码执行之后结果如图，无法解决

1. Sub 随机()
   
2.     Dim d As Object, ar(1 To 10000, 1 To 1)
   
3.     Range("a1:a10000").NumberFormatLocal = "00000"
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Do
   
6.         Randomize
   
7.         s = Int(Rnd * 10)
   
8.         d(s) = ""
   
9.         If d.Count = 5 Then
   
10.             n = n + 1
    
11.             m = d.keys
    
12.             For j = 1 To d.Count
    
13.                 ar(n, 1) = ar(n, 1) & m(j - 1)
    
14.             Next
    
15.             d.RemoveAll
    
16.         End If
    
17.     Loop While n < 10000
    
18.     Range("a1").Resize(10000, 1) = ar
    
19. End Sub
    

复制代码

跳转到最佳答案楼层

as0810114

for循环前面加一个  Randomize

米特峰

as0810114 发表于 2014-12-8 12:51
for循环前面加一个  Randomize

还是一样有重复

as0810114

米特峰 发表于 2014-12-8 13:04
还是一样有重复

我测试了没有重复

as0810114

你自己用公式验证吧
=COUNT(FIND({0;1;2;3;4;5;6;7;8;9},A1))+5-LEN(A1)

xdragon

1. Sub 随机()
   
2. Range("a1:a10000").NumberFormatLocal = "00000"
   
3. VBA.Randomize
   
4. For i = 1 To 10000
   
5.   Cells(i, 1) = "": s = Int(Rnd * 10): sr = s
   
6.   For x = 1 To 4
   
7.     While InStr(sr, s)
   
8.       s = Int(Rnd * 10)
   
9.     Wend
   
10.     sr = sr & s
    
11.   Next
    
12.   Cells(i, 1) = sr
    
13. Next
    
14. End Sub

复制代码

米特峰

as0810114 发表于 2014-12-8 13:13
你自己用公式验证吧
=COUNT(FIND({0;1;2;3;4;5;6;7;8;9},A1))+5-LEN(A1)

1. Sub 随机()
   
2. Range("a1:a10000").NumberFormatLocal = "00000"
   
3. Randomize
   
4. For i = 1 To 10000
   
5.   Cells(i, 1) = "": s = Int(Rnd * 10)
   
6.   For x = 1 To 5
   
7.     While InStr(Cells(i, 1), s)
   
8.       s = Int(Rnd * 10)
   
9.     Wend
   
10.     Cells(i, 1) = Cells(i, 1) & s
    
11.   Next
    
12. Next
    
13. End Sub
    

复制代码

代码执行之后结果如图，无法解决

qh8600

米特峰 发表于 2014-12-8 13:20
代码执行之后结果如图，无法解决

1. Sub 随机()
   
2.     Dim d As Object, ar(1 To 10000, 1 To 1)
   
3.     Range("a1:a10000").NumberFormatLocal = "00000"
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Do
   
6.         Randomize
   
7.         s = Int(Rnd * 10)
   
8.         d(s) = ""
   
9.         If d.Count = 5 Then
   
10.             n = n + 1
    
11.             m = d.keys
    
12.             For j = 1 To d.Count
    
13.                 ar(n, 1) = ar(n, 1) & m(j - 1)
    
14.             Next
    
15.             d.RemoveAll
    
16.         End If
    
17.     Loop While n < 10000
    
18.     Range("a1").Resize(10000, 1) = ar
    
19. End Sub
    

复制代码

米特峰

qh8600 发表于 2014-12-8 13:29

运行速度提高了许多，结果正确无误，谢谢老师！

米特峰

xdragon老师后期指导

1. Sub 随机()
   
2. Dim i%, s$, sr$, re$(1 To 10000, 1 To 1)
   
3. Range("a1:a10000").NumberFormatLocal = "00000"
   
4. VBA.Randomize
   
5. For i = 1 To 10000
   
6.   s = Int(Rnd * 10): sr = s
   
7.   For x = 1 To 4
   
8.     While InStr(sr, s)
   
9.       s = Int(Rnd * 10)
   
10.     Wend
    
11.     sr = sr & s
    
12.   Next
    
13.   re(i, 1) = sr
    
14. Next
    
15. Range("A1:A10000") = re
    
16. End Sub

复制代码