ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 338|回复: 9

[求助] 随机多重复制

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-1-11 19:27 | 显示全部楼层 |阅读模式
求高手解决多种随机复制

两重随机复制.rar

502.43 KB, 下载次数: 9

TA的精华主题

TA的得分主题

发表于 2019-1-11 20:27 | 显示全部楼层
  1. Sub t()
  2.   Dim arr, i%, j, k, d, s
  3.   Set d = CreateObject("Scripting.Dictionary")
  4.   arr = Range("a2:c" & [a65536].End(xlUp).Row)
  5.   k = 1
  6.    For i = 1 To UBound(arr)
  7.      s = 0
  8.       If arr(i, 3) > 5 Then
  9.       Do
  10.        j = WorksheetFunction.RandBetween(1, 5)
  11.        s = s + j
  12.        d(k) = Array(arr(i, 1), arr(i, 2), j)
  13.        k = k + 1
  14.           If arr(i, 3) - s >= 1 And arr(i, 3) - s <= 5 Then
  15.           d(k) = Array(arr(i, 1), arr(i, 2), arr(i, 3) - s)
  16.           k = k + 1
  17.           Exit Do
  18.           End If
  19.       Loop
  20.     Else
  21.        d(k) = Array(arr(i, 1), arr(i, 2), arr(i, 3))
  22.        k = k + 1
  23.     End If
  24.   Next
  25. i = 1
  26. For Each sj In d.items
  27.    Range("k" & i & ":m" & i) = sj
  28.    i = i + 1
  29. Next
  30. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2019-1-11 21:21 | 显示全部楼层
  1. Sub dsmch()
  2. Dim arr, brr, i&, s&
  3. arr = Range("a1").CurrentRegion.Resize(, 3)
  4. ReDim brr(1 To 60000, 1 To 3)
  5. For i = 2 To UBound(arr)
  6.     n = arr(i, 3)
  7.     If n <= 5 Then
  8.         s2 = i: x = n
  9.         GoSub 100
  10.     Else
  11.         Do While n > 5
  12.             x = Int(Rnd * 5 + 1)
  13.             s2 = i
  14.             GoSub 100
  15.             n = n - x
  16.         Loop
  17.         x = n
  18.         GoSub 100
  19.     End If
  20. Next
  21. Range("g2").Resize(s, 3) = brr: Exit Sub
  22. 100:
  23. s = s + 1
  24. brr(s, 1) = arr(s2, 1)
  25. brr(s, 2) = arr(s2, 2)
  26. brr(s, 3) = x
  27. Return
  28. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-12 13:23 | 显示全部楼层
用在我的另一个文件里,产生的数值全部是1,这是什么原因

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-12 16:06 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-1-12 17:16 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-12 22:01 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-15 07:47 | 显示全部楼层
dsmch 发表于 2019-1-12 17:16
代码中的三处5改为3

假如要使出现的数1出现的比例为50%,2出现的比例为30%,3出现的比例为20%,以及比例的调节有没有新的方法

TA的精华主题

TA的得分主题

发表于 2019-1-15 09:10 | 显示全部楼层
wyjgni 发表于 2019-1-15 07:47
假如要使出现的数1出现的比例为50%,2出现的比例为30%,3出现的比例为20%,以及比例的调节有没有新的方法

假如数是1,50%、30%、20%有什么差别?

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-15 18:28 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-20 20:28 , Processed in 0.065800 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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