概述
1 普通随机,利用 rnd()
- 很可能随机出重复的值,因为对应是 放回随机 的方法
- 缺省值
- Randomize 等同于 Randomize timer 用时间做了随机种子
- rnd等同于 rnd(1) 或 rnd(正数)
Sub cs1()
s = 10
For i = 1 To s
Call cs2
Next
End Sub
Sub cs2()
Randomize
p1 = Int(1 + 10 * Rnd)
Debug.Print "p1= " & p1
End Sub
2 如果要实现,不重复的随机数 / 或者叫 不放回随机数
- 核心就是:不重复随机数 = "不放回抽样" 随机
- 设计拿掉对应的代码是核心
2.1 先写了一个固定次数的,简单的模型
- 先写了一个固定的几次随机,试水
- 权重求和时,引入了参数,记录每次随机的结果,判断0/1
- 把权重区间,都设计为动态的, 这样下次随机就可以动态重新调整权重
- 但是,需要考虑, 权重区间段,要先判断小的,在判断大的这样的次序
Dim g1, g2, g3
'设计拿掉对应的代码是核心
Sub ttt1()
Call intial1
For i = 1 To 3
Debug.Print "第" & i & "次",
Call fff1
Next
End Sub
Function intial1()
'初始化
g1 = 1
g2 = 1
g3 = 1
End Function
Function fff1()
' '初始化放在这错的
' g1 = 1
' g2 = 1
' g3 = 1
'
pp1 = 2000
pp2 = 3000
pp3 = 5000
'随机
Randomize
p1 = Int(1 + (pp1 * g1 + pp2 * g2 + pp3 * g3) * Rnd)
Debug.Print "本次p1=" & p1,
Debug.Print "本次总p=" & pp1 * g1 + pp2 * g2 + pp3 * g3,
'判断
Select Case p1
Case Is <= pp1 * g1
g1 = 0
Debug.Print "抽中1",
Case Is <= pp1 * g1 + pp2 * g2
g2 = 0
Debug.Print "抽中2",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3
g3 = 0
Debug.Print "抽中3",
End Select
Debug.Print "当前g1=" & g1,
Debug.Print "当前g2=" & g2,
Debug.Print "当前g3=" & g3,
Debug.Print
End Function
2.2 写一个扩展的,但是手动扩展,太傻了。。。
- 这种纯手写,新增长度的代码,其实没有扩展性,每次都得重新再改,比如到11个数字呢,这个又得再改
- 然后,我现在也很讨厌这种枚举得方式,烦,太长
- 扩展性太差了
- 理论上应该从2个随机,就直接可以扩展到N个随机得代码才舒服。
Dim g1, g2, g3, g4, g5, g6, g7, g8, g9, g10
Sub ttt2()
Call intial2
s1 = "A"
s2 = "B"
s3 = "C"
s4 = "D"
s5 = 1
s6 = 2
s7 = 3
s8 = 4
s9 = 5
s10 = 6
s = 10
For i = 1 To s
Debug.Print "第" & i & "次",
Call fff2
Next
End Sub
Function intial2()
'初始化
g1 = 1
g2 = 1
g3 = 1
g4 = 1
g5 = 1
g6 = 1
g7 = 1
g8 = 1
g9 = 1
g10 = 1
End Function
Function fff2()
' '初始化放在这错的
' g1 = 1
' g2 = 1
' g3 = 1
'
pp1 = 1
pp2 = 1
pp3 = 1
pp4 = 1
pp5 = 1
pp6 = 1
pp7 = 1
pp8 = 1
pp9 = 1
pp10 = 1
'随机
Randomize
' 直接加不如用for
p1 = Int(1 + (pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5 + pp6 * g6 + pp7 * g7 + pp8 * g8 + pp9 * g9 + pp10 * g10) * Rnd)
Debug.Print "本次p1=" & p1,
Debug.Print "本次总p=" & pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5 + pp6 * g6 + pp7 * g7 + pp8 * g8 + pp9 * g9 + pp10 * g10,
'判断 ---范围也得改把?
Select Case p1
Case Is <= pp1 * g1
g1 = 0
Debug.Print "抽中1",
Case Is <= pp1 * g1 + pp2 * g2
g2 = 0
Debug.Print "抽中2",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3
g3 = 0
Debug.Print "抽中3",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4
g4 = 0
Debug.Print "抽中4",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5
g5 = 0
Debug.Print "抽中5",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5 + pp6 * g6
g6 = 0
Debug.Print "抽中6",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5 + pp6 * g6 + pp7 * g7
g7 = 0
Debug.Print "抽中7",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5 + pp6 * g6 + pp7 * g7 + pp8 * g8
g8 = 0
Debug.Print "抽中8",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5 + pp6 * g6 + pp7 * g7 + pp8 * g8 + pp9 * g9
g9 = 0
Debug.Print "抽中9",
Case Is <= pp1 * g1 + pp2 * g2 + pp3 * g3 + pp4 * g4 + pp5 * g5 + pp6 * g6 + pp7 * g7 + pp8 * g8 + pp9 * g9 + pp10 * g10
g10 = 0
Debug.Print "抽中10",
End Select
Debug.Print "当前g1=" & g1,
Debug.Print "当前g2=" & g2,
Debug.Print "当前g3=" & g3,
Debug.Print "当前g4=" & g4,
Debug.Print "当前g5=" & g5,
Debug.Print "当前g6=" & g6,
Debug.Print "当前g7=" & g7,
Debug.Print "当前g8=" & g8,
Debug.Print "当前g9=" & g9,
Debug.Print "当前g10=" & g10,
Debug.Print
End Function
2.3 尝试直接扩展为N个,写动态变量,和写动态得if分支都遇到问题 (暂时从这个角度不行)
- 内容已经预先定义好,比如就是数字,或桌球扑克等,可以先定义是什么,和文本没区别
- 变量定义,无法动态定义不确定数量得 变量
- 比如定义 a & i 这样直接报错
- if 得判断分支
- 无法动态创建 if 的动态分支
- 没法根据 可能的变量个数,动态创建更多分支啊
2.4 动态创建数组的方法 + 用单个if 分支判断的方法,实现动态的 不放回随机
- 我记得form表单里还可以动态修改控件名称,比如 Controls("Label" & (41 + i)).Caption
- 但是VBA里好像没办法实现 g& i 这样的动态变量名,这样会报错(或者被认为是变量 gi)
- 查了下,好像想要,动态生成变量只能数组或字典
- 然后,这些可以整理 包装为 一个 自定义函数,给excel用,把数据源改成range,我等会试试
实现技巧
- 用数组实现了 变量的动态生成:想求N个数随机,就动态redim一个N大小的数组
- 累计权重,权重区间等,都用循环的方法,累计生成
- 因为if 不能动态创建分支,因此用 循环 内嵌套一个2分支的if的方法,逐个遍历要判断的分支,每次用一个独立完整的if判断
s = 10
ReDim arr1(1 To s)
For i = 1 To s
arr1(i) = 100 + i ' 内容从表里读区域把,如Range() ,枚举太恶心了
Next
For i = 1 To s
p0 = p0 + arr2(i) * arr3(i)
Next
For i = 1 To s
p2 = p2 + arr2(i) * arr3(i)
If p1 <= p2 Then
arr3(i) = 0
' Debug.Print "本次p2= " & p2,
Debug.Print "抽中 " & arr1(i),
Debug.Print "当前arr3(" & i & ")= " & arr3(i),
Exit For
Else
' Debug.Print "?", '测试用,显示未中奖之前得过程
End If
Next
Private arr3()
Sub ttt3()
'不能动态变量
'就2个动态数组,存2个组变量?1组存变量,1组存权重
Dim arr1()
Dim arr2()
'Dim arr3() '得模块级,另外一个过程得修改它
s = 10
ReDim arr1(1 To s)
For i = 1 To s
arr1(i) = 100 + i ' 内容从表里读区域把,如Range() ,枚举太恶心了
Next
ReDim arr2(1 To s)
For i = 1 To s
arr2(i) = 1 '权重平均都是1, 不规律得也可以读表,或按规律生成,枚举太恶心也有限
Next
ReDim arr3(1 To s) '标记数组
For i = 1 To s
arr3(i) = 1
Next
For i = 1 To s
Debug.Print "第" & i & "次",
Call fff3(arr1(), arr2(), arr3(), s)
Next
End Sub
Function fff3(arr1(), arr2(), arr3(), s)
's可以不传递,用ubound可以代替
For i = 1 To s
p0 = p0 + arr2(i) * arr3(i)
Next
'随机
Randomize
' pp1 = 1 '权重概率相等
' p1 = Int(1 + (pp1 * g1 * s) * Rnd)
' 直接加不如用for
p1 = Int(1 + p0 * Rnd)
Debug.Print "本次p1=" & p1,
Debug.Print "本次总p0=" & p0,
'判断 --判断范围,判断分支可以动态么?如果不行,那么用for i的形式,每次判断1次。单个if,但是循环多次?
p2 = 0
For i = 1 To s
p2 = p2 + arr2(i) * arr3(i)
If p1 <= p2 Then
arr3(i) = 0
' Debug.Print "本次p2= " & p2,
Debug.Print "抽中 " & arr1(i),
Debug.Print "当前arr3(" & i & ")= " & arr3(i),
GoTo line2 '这么干得保证,序列是从小到大,符合if分支得次序
Else
' Debug.Print "?", '测试用,显示未中奖之前得过程
End If
Next
line2:
Debug.Print
End Function
下面代码是吧 goto line2 换成了 exit for 一样的效果
Private arr3()
Sub ttt3()
Dim arr1()
Dim arr2()
'Dim arr3() '得模块级,另外一个过程得修改它
s = 10
ReDim arr1(1 To s)
For i = 1 To s
arr1(i) = 100 + i ' 内容从表里读区域把,如Range() ,枚举太恶心了
Next
ReDim arr2(1 To s)
For i = 1 To s
arr2(i) = 1 '权重平均都是1, 不规律得也可以读表,或按规律生成,枚举太恶心也有限
Next
ReDim arr3(1 To s) '标记数组
For i = 1 To s
arr3(i) = 1
Next
For i = 1 To s
Debug.Print "第" & i & "次",
Call fff3(arr1(), arr2(), arr3(), s)
Next
End Sub
Function fff3(arr1(), arr2(), arr3(), s)
For i = 1 To s
p0 = p0 + arr2(i) * arr3(i)
Next
'随机
Randomize
p1 = Int(1 + p0 * Rnd)
Debug.Print "本次p1=" & p1,
Debug.Print "本次总p0=" & p0,
p2 = 0
For i = 1 To s
p2 = p2 + arr2(i) * arr3(i)
If p1 <= p2 Then
arr3(i) = 0
' Debug.Print "本次p2= " & p2,
Debug.Print "抽中 " & arr1(i),
Debug.Print "当前arr3(" & i & ")= " & arr3(i),
Exit For
Else
' Debug.Print "?", '测试用,显示未中奖之前得过程
End If
Next
Debug.Print
End Function
2.5 试包装为一个 自定义函数,给excel用,把数据源改成range
- 好用
- 可以动态得根据,当前sheet得指定列得范围,动态读随机范围
- 可以在表上改数据内容,重设随机
- 输出列也在表上第5列,指定位置显示
'读表,并修改为自定义函数
Function rand_dep1()
' path1 = ThisWorkbook.Path
' name1 = ThisWorkbook.Name
' Sheet1 = "测试"
Dim arr1()
Dim arr2()
'Dim arr3() '得模块级,另外一个过程得修改它
'自动根据表上内容更新
maxr1 = Range("a999").End(xlUp).Row
'有表头的话得去掉表头,且要求列内内容连续,数据不能中间有空行
s = maxr1 - 1
'内容
ReDim arr1(1 To s)
For i = 1 To s
arr1(i) = Cells(i + 1, 2)
Next
'权重
ReDim arr2(1 To s)
For i = 1 To s
arr2(i) = Cells(i + 1, 3)
Next
'标记
ReDim arr3(1 To s)
For i = 1 To s
arr3(i) = 1
Next
For i = 1 To s
Debug.Print "第" & i & "次",
Call rand_dep2(arr1(), arr2(), arr3(), s, i)
Next
rand_dep1 = "done"
End Function
Function rand_dep2(arr1(), arr2(), arr3(), s, i)
For a = 1 To s
p0 = p0 + arr2(a) * arr3(a)
Next
'随机
Randomize
p1 = Int(1 + p0 * Rnd)
Debug.Print "本次p1=" & p1,
Debug.Print "本次总p0=" & p0,
p2 = 0
For j = 1 To s
p2 = p2 + arr2(j) * arr3(j)
If p1 <= p2 Then
arr3(j) = 0
Cells(i + 1, 5) = arr1(j)
Debug.Print "抽中 " & arr1(j),
Debug.Print "当前arr3(" & j & ")= " & arr3(j),
Exit For
Else
' Debug.Print "?", '测试用,显示未中奖之前得过程
End If
Next
Debug.Print
End Function
2.6 但是问题来了,为啥这样设置自定义函数不行呢?
Function qiuhe1(a, b)
qiuhe1 = a + b
End Function
Function qiuhe111() '自定义函数正常
qiuhe111 = 100
End Function
Function qiuhe112() '这个弄成自定义函数就返回错误值
qiuhe112 = 100
Cells(3, 6) = "自定义函数qiuhe112=" '这一句得问题?
End Function
3 一些要注意的问题
- 1 例子里因为有双层循环,内层循环相关的 变量初始化,比如例子里的,抽中变量g1等的初始化,必须放在 内层循环外。否则每次开始内层循环,变量被意外重置了
- 2 if 写动态创建 if的判断分支,好像有点难
- 3 我写的这个 for 循环 里包含的 if 判断,只有2个分支, Debug.Print "?", '测试用,显示未中奖的情况debug. 也就是说,只要本次没随中,就会继续下去。
- 但是随中了,以后下一个肯定也是符合 p1 < 更大的p2,后面的都会判断,这是不符合目标的,所以直接跳出循环了。这里用 exit for应该也可以吧。应该exit for 比 goto line2 更好一些。
- 4 过程之间,可以传递变量,或传递数组也是可以的. 数组(名)也是变量。
- 5 arr3() 作为中奖标记参数,存储的数组,需要被2个过程都修改,所以需要声明为模块级
4 未完成部分
:INDEX(B2:B21,MATCH(5,A2:A21,0))
:字典的方法,更简单
https://jingyan.baidu.com/article/6079ad0ec78a5828ff86db1a.html
VBA生成不重复的随机数_百度知道
或者用数组相减 filter?
三个vba生成不重复随机整数的案例
VBA产生特定范围内的随机数 | VBA实例教程
【VBA研究】VBA编程产生不重复随机数_驽马十驾 才定不舍-CSDN博客_vba 随机数
4.1 EXCEL表里的随机公式
不去重和去重
- choose(RANDBETWEEN(1,20),a1,a2,a3)
- INDEX(B2:B21,RANDBETWEEN(1,20)) 写法更简单
- 公式里好像没法直接去重随机吧?
4.2 曾经想过,除了用 标记参数标记意外,还考虑用filter 进行数组的相减,也可以动态控制吧
4.3 网上看到有人用字典的方法,比我的简单
最后
以上就是诚心流沙为你收集整理的VBA,如何获得不重复随机数(实现不放回随机)的几种方法------ 未完成(还想补充一些字典的方法等)---1 普通随机,利用 rnd()2 如果要实现,不重复的随机数 / 或者叫 不放回随机数3 一些要注意的问题4 未完成部分的全部内容,希望文章能够帮你解决VBA,如何获得不重复随机数(实现不放回随机)的几种方法------ 未完成(还想补充一些字典的方法等)---1 普通随机,利用 rnd()2 如果要实现,不重复的随机数 / 或者叫 不放回随机数3 一些要注意的问题4 未完成部分所遇到的程序开发问题。
如果觉得靠谱客网站的内容还不错,欢迎将靠谱客网站推荐给程序员好友。
发表评论 取消回复