设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 不重复随机数的难题
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 4200|回复: 8

[已解决]不重复随机数的难题

[复制链接]
发表于 2013-6-22 19:30 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
不重复随机数，好难啊。
最佳答案
月排行榜 / 总排行榜
hoogle
2013-6-22 20:40
  1. Sub hoogle()
  2. Dim i, j, K, d, Result, T
  3. Range("d3:h27").ClearContents
  4. Result = Range("d3:h27")
  5. Set d = CreateObject("scripting.dictionary")
  6. For i = 1 To UBound(Result)
  7.    For j = 1 To UBound(Result, 2)
  8.         T = ID
  9.         Do Until Not d.exists(T)
  10.             ID
  11.             T = ID
  12.         Loop
  13.         Result(i, j) = T
  14.         d(T) = ""
  15.     Next
  16. Next
  17. Range("D3:H27") = Result
  18. End Sub
  19. Function ID()
  20. Dim upperbound, lowerbound, K, temp(1 To 2), arr(1 To 8)
  21. lowerbound = 0: upperbound = 9
  22. For K = 1 To UBound(arr)
  23.     Randomize
  24.     arr(K) = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
  25. Next
  26. temp(1) = arr(1) & arr(2) & arr(3) & arr(4) & arr(5)
  27. temp(2) = arr(6) & arr(7) & arr(8)
  28. ID = "MN-" & temp(1) & "*QQ" & temp(2) & "-CW"
  29. End Function
复制代码

随机数的难题.rar

2.19 KB, 下载次数: 8
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
 楼主| 发表于 2013-6-22 19:43 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
数学不是很好，根据概率应该有：10^8次方=100000000 种可能。
回复

使用道具 举报

发表于 2013-6-22 20:37 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
D3输入公式
  1. ="MN-"&TEXT(RANDBETWEEN(0,99999),"00000")&"*QQ"&TEXT(RANDBETWEEN(0,999),"000")&"-CW"
复制代码
右拉下拉。
回复

使用道具 举报

hoogle
发表于 2013-6-22 20:40 | 显示全部楼层    本楼为最佳答案   
  1. Sub hoogle()
  2. Dim i, j, K, d, Result, T
  3. Range("d3:h27").ClearContents
  4. Result = Range("d3:h27")
  5. Set d = CreateObject("scripting.dictionary")
  6. For i = 1 To UBound(Result)
  7.    For j = 1 To UBound(Result, 2)
  8.         T = ID
  9.         Do Until Not d.exists(T)
  10.             ID
  11.             T = ID
  12.         Loop
  13.         Result(i, j) = T
  14.         d(T) = ""
  15.     Next
  16. Next
  17. Range("D3:H27") = Result
  18. End Sub
  19. Function ID()
  20. Dim upperbound, lowerbound, K, temp(1 To 2), arr(1 To 8)
  21. lowerbound = 0: upperbound = 9
  22. For K = 1 To UBound(arr)
  23.     Randomize
  24.     arr(K) = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
  25. Next
  26. temp(1) = arr(1) & arr(2) & arr(3) & arr(4) & arr(5)
  27. temp(2) = arr(6) & arr(7) & arr(8)
  28. ID = "MN-" & temp(1) & "*QQ" & temp(2) & "-CW"
  29. End Function
复制代码
回复

使用道具 举报

hoogle
发表于 2013-6-22 20:43 | 显示全部楼层
随机数的难题.rar (11.22 KB, 下载次数: 10)
回复

使用道具 举报

 楼主| 发表于 2013-6-22 20:47 | 显示全部楼层
hoogle 发表于 2013-6-22 20:40

temp(1 To 2), arr(1 To 8)  中的  2 和  8  表示什么？是列数还是？
回复

使用道具 举报

hoogle
发表于 2013-6-22 20:49 | 显示全部楼层
张雄友 发表于 2013-6-22 20:47
temp(1 To 2), arr(1 To 8)  中的  2 和  8  表示什么？是列数还是？

这是数组，temp()有两个数，一个放前半部分（5个数随机部分），一个放后半部分（3个数随机）。
回复

使用道具 举报

 楼主| 发表于 2013-6-23 15:48 | 显示全部楼层
hoogle 发表于 2013-6-22 20:49
这是数组，temp()有两个数，一个放前半部分（5个数随机部分），一个放后半部分（3个数随机）。
  1. Sub maditate()
  2.     Selection.ClearContents

  4.     Dim i&, k&, l1&, l2&, m&, n&, rw&, cl&, r$, s$, s1$, s2$, tms#
  5.     tms = Timer
  6.    
  7.     arr = Selection '获取需要生成不重复随机数的表格区域arr
  8.     rw = UBound(arr): cl = UBound(arr, 2): m = rw * cl   '计算所需生成随机数的总数m
  9.     Selection.Resize(rw, cl) = ""
  10.    
  11.     l1 = 5: s1 = String(l1, "0"): l2 = 3: s2 = String(l2, "0")
  12.    
  13.     Set d = CreateObject("Scripting.Dictionary") '建立字典
  14.    
  15.     '前五位不重复随机数
  16.     k = 0
  17.     Do
  18.         Randomize
  19.         r = Right(s1 & Int(10 ^ l1 * Rnd), l1)
  20.         If Not d.Exists(r) Then
  21.             d(r) = ""
  22.             k = k + 1: If k = m Then Exit Do
  23.         End If
  24.     Loop
  25.    
  26.     '后三位不重复随机数
  27.     k = 0
  28.     Do
  29.         Randomize
  30.         r = Right(s2 & Int(10 ^ l2 * Rnd), l2)
  31.         If Not d.Exists(r) Then
  32.             d(r) = ""
  33.             k = k + 1: If k = m Then Exit Do
  34.         End If
  35.     Loop
  36.    
  37.     '将随机数组合成编码
  38.     ReDim brr(rw, cl)
  39.     p = d.keys
  40.     For i = 0 To m - 1
  41.       brr(i \ cl, i Mod cl) = "MN-" & p(i) & "*QQ" & p(i + m) & "-CW"
  42.     Next
  43.    
  44.     '输出编码
  45.     Selection.Resize(rw, cl) = crr
  46.     MsgBox Format(Timer - tms, "0.000s")
  47.    
  48. End Sub
复制代码
我这个为什么没有数据出来的？？？？
回复

使用道具 举报

 楼主| 发表于 2013-6-23 16:34 | 显示全部楼层
专家在？
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-30 04:26 , Processed in 0.299332 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表