Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3636|回复: 15

[已解决]批量生成随机数中植入指定数据的问题

[复制链接]
发表于 2013-1-8 11:33 | 显示全部楼层 |阅读模式
附件 批量生成文件.rar (10.58 KB, 下载次数: 13)
发表于 2013-1-8 17:13 | 显示全部楼层
你的要求说明很混乱,不好理解。

希望能举出至少一个实际例子。


每一列的数都是随机的。现在想事先指定任意五个数,
比如事先指定23 43 12 22 43,
要求在生成的时候,每一列都要出现一次这五个连续的数(至少出现一次)。
出现的位置,完全随机。
【问题:这五个连续的数指的是哪几个数?你事先指定的23 43 12 22 43这五个数根本不连续啊】

五个连续的任意数,可以有重复的。
【问题:五个连续的数还要有重复?重复了就没有五个连续数了。比如21,22,21,22,22就只剩下两个连续的数了。】


设置表单中,原有的参数都是可变的,保持原样。


回复

使用道具 举报

 楼主| 发表于 2013-1-8 17:47 | 显示全部楼层
香川群子 发表于 2013-1-8 17:13
你的要求说明很混乱,不好理解。

希望能举出至少一个实际例子。

谢谢老师关注。

这 五个连续的数  比如23 43 12 22 43,它并不是固定不变的。假如我今天指定这五个连续的数,明天我可能会根据需要,指定另外五个连续的数 如21 45 45 15 42   一句话,这五个连续的数,是根据需要指定的。

所谓连续,指的是连在一起。比如第100行是23 第101行是43 第102行是12  第103行是22  第104行是43

所谓重复,是指这五个数里,允许有相同的数据出现。比如上面的23 43 12 22 43       21 45 45 15 42
回复

使用道具 举报

发表于 2013-1-8 22:40 | 显示全部楼层
为了确保五个连续数在同一列中多次出现时,不产生相互重叠,
利用了我自己编写的自动生成均匀随机序号的代码,稍微复杂了一点。
  1. Sub RndNumCol()
  2.     tms = Timer
  3.    
  4.     Dim Mx&, Mn&, Rs&, Col%, Fcnt%
  5.     Dim i&, j&, k&, n%, f%, rw&, cl%, r&, c%, c1%, c2%
  6.    
  7.     Mx = [最大数]: Mn = [最小数]: If Mx <= Mn Then MsgBox "最大数必须大于最小数.": Exit Sub
  8.     Rs = [行数]: If Rs < 1 Or Rs > 65536 Then MsgBox "请准确设置行数(1-65536)": Exit Sub
  9.     If Rs Mod (Mx - Mn + 1) Then MsgBox "生成行数必须是选字数字的倍数": Exit Sub
  10.     Col = [列数]: If Col < 1 Or Col > 256 Then MsgBox "请准确设置列数": Exit Sub
  11.         
  12.     ReDim Arr(1 To Rs, 0 To Col)
  13. '    Bs = Rs / (Mx - Mn + 1) '倍数=取数个数的倍数
  14.     For j = 1 To Rs / (Mx - Mn + 1)
  15.         For i = Mn To Mx
  16.             k = k + 1
  17.             Arr(k, Col) = i
  18.         Next
  19.     Next
  20.         
  21.     lxs = [指定连续数]: c1 = [下限次数]: c2 = [上限次数]
  22.     n = UBound(lxs)
  23.     Fcnt = [文件数]
  24.    
  25.     Randomize
  26.     Application.DisplayAlerts = False
  27.     Application.ScreenUpdating = False
  28.    
  29.     For f = 1 To Fcnt
  30.         Workbooks.Add 1
  31.         For cl = 0 To Col - 1
  32.             For rw = Rs To 1 Step -1
  33.                 r = Int(Rnd * rw) + 1
  34.                 Arr(rw, cl) = Arr(r, Col)  't=r
  35.                 Arr(r, cl) = Arr(rw, Col)  'r=rw
  36.                 Arr(rw, Col) = Arr(rw, cl)  'rw=t
  37.                 Arr(r, Col) = Arr(r, cl)  'r=rw
  38.             Next
  39.             c = Int(Rnd * (c2 - c1 + 1) + c1)
  40.             crr = GetRndAvg(1, Rs - n + 1, c, n)
  41.             For c = 1 To c
  42.                 r = crr(c) - 1
  43.                 For k = 1 To n
  44.                     Arr(r + k, cl) = lxs(k, 1)
  45.                 Next
  46.             Next
  47.         Next
  48.         ActiveSheet.Cells(1, 1).Resize(Rs, Col) = Arr
  49.         ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & f '& ".xls"
  50.         ActiveWorkbook.Close
  51.     Next
  52.     Application.ScreenUpdating = True
  53.     MsgBox Format(Timer - tms, "0.000s")
  54. End Sub


复制代码
另外,写入文件是否可以用txt方法,速度会更快。

批量生成文件.rar

16.99 KB, 下载次数: 5

回复

使用道具 举报

发表于 2013-1-8 22:42 | 显示全部楼层
代码中引用的,自动生成有间隔要求的均匀随机不重复序号的代码:

  1. Function GetRndAvg(a, b, m, Optional h = 1, Optional s = 1)
  2.       '参数:[起始整数a(负数可)]、[结束整数b(大于a,负数可)]、[抽取个数m]、
  3.     '       [最小间隔h(默认=1)]、[排序参数s(默认1=升序、0=随机、-1=倒序)]
  4.    Randomize
  5.     Dim i&, n&, r&, t&
  6.    
  7.     ReDim c(1 To m)
  8.     If b - a < m * h Then c(1) = a Else c(1) = Int(((b - a + 1) / m - h) * Rnd()) + a
  9.     If m = 1 Then GetRndAvg = c: Exit Function
  10.     Do Until n = m - 1
  11.         n = n + 1
  12.         If b - c(n) < (m - n) * h Then
  13.             If c(n) + h <= b Then
  14.                 c(n + 1) = c(n) + h
  15.             Else
  16.                 GoTo Ext
  17.             End If
  18.         Else
  19.             c(n + 1) = c(n) + Int(((b - c(n) + 1) / (m - n) - h) * Rnd() * 2) + h
  20.         End If
  21.     Loop
  22.     c(m) = c(n) + Int((b - c(n) + 1 - h) * Rnd()) + h
  23. Ext:
  24.     If s = 0 Then
  25.         For i = 1 To m '正序洗牌
  26.             r = Int((m - i + 1) * Rnd()) + i
  27.             t = c(r): c(r) = c(i): c(i) = t
  28.         Next
  29.     ElseIf s = -1 Then
  30.         For i = 1 To m \ 2 '倒序交換
  31.             t = c(m - i + 1): c(m - i + 1) = c(i): c(i) = t
  32.         Next
  33.     End If
  34.     GetRndAvg = c
  35.    
  36. End Function
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-1-8 23:17 | 显示全部楼层
香川群子 发表于 2013-1-8 22:40
为了确保五个连续数在同一列中多次出现时,不产生相互重叠,
利用了我自己编写的自动生成均匀随机序号的代 ...

老师您好,谢谢您帮忙。

下载试了一下,不知生成的文件保存在哪了?找不到啊。

望指教。
回复

使用道具 举报

发表于 2013-1-9 08:59 | 显示全部楼层
输出文件应该是保存在你打开的程序文件所在的同一文件夹里啊。

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\"

这一句代码还是你原来程序中就有的,我没有改。
回复

使用道具 举报

 楼主| 发表于 2013-1-9 09:47 | 显示全部楼层
香川群子 发表于 2013-1-9 08:59
输出文件应该是保存在你打开的程序文件所在的同一文件夹里啊。

ActiveWorkbook.SaveAs ThisWorkbook.Pat ...

我下载了4楼的附件,执行后,在原目录下没有看到有结果。麻烦老师试试看。谢谢。
回复

使用道具 举报

发表于 2013-1-9 11:50 | 显示全部楼层    本楼为最佳答案   
我这里测试正常。

GetRndFile.zip

18.42 KB, 下载次数: 17

评分

参与人数 1 +1 收起 理由
小小玩童 + 1 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2013-2-19 23:10 | 显示全部楼层
香川群子 发表于 2013-1-9 11:50
我这里测试正常。

老师新年好!您帮忙弄的这个程序,经过一段时间的使用,感觉很好。只是有一点小小问题不解。

就是:生成的文件数,极限是32000多一点。33000就不行了。理想的文件数是20万或不受限制。不知能否稍加修改一下?

目前生成32000文件,行数是4998,列数是3,完成需要2个小时。如果能无限增加文件数,理想的运行时间8个小时,即生成12万多点。

谢谢老师!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 20:40 , Processed in 0.600376 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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