VBA，如何获得不重复随机数（实现不放回随机）的几种方法------ 未完成（还想补充一些字典的方法等）---

已于 2022-01-21 10:32:45 修改
阅读量6k 收藏 8
点赞数
分类专栏： # VBA实验 文章标签： excel vba
于 2022-01-19 11:53:07 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/xuemanqianshan/article/details/122577772
版权

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随机抽取人名不重复_VBA中随机数的利用
weixin_36181191的博客
01-08 1193
大家好,最近推出的内容是“VBA信息获取与处理”中的部分内容，这套教程面向中高级人员，涉及范围更广，实用性更强，现在的内容是第二个专题“随机数（Random）在EXCEL工作表及VBA中的应用”的内容。对于数据处理而言，随机信息的处理是非常重要的一部分，什么是随机数呢？随机数是专门的随机试验的结果。在统计学的不同技术中需要使用随机数，比如在从统计总体中抽取有代表性的样本的时候，或者在将实验动物分配...
VBA生成不重复的随机数源码.txt
04-13
VBA生成不重复的随机数源码.txt
VBA 生成不重复的随机数
最新发布
记录
07-17 860
VBA 生成不重复的随机数
【VBA研究】VBA编程产生不重复随机数
热门推荐
驽马十驾 才定不舍
08-08 3万+
作者：iamlasong VBA编程实现不重复随机数输出。VBA里的随机函数是RND，在工作表中随机函数是RAND，一字之差，可要记好了。RND取值范围是[0,1)，意思是0和1之间的一个随机数，包含0，但不包含1。 1、用法 语法：Rnd[(number)] 　　如果 number 的值是 Randomize 生成 　　小于 0 ，每次都使用 number 作为随机数种子得到的相同结果
VBA编程产生不重复随机数（转载）
l_iu_xing的博客
06-04 4097
https://blog.csdn.net/iamlaosong/article/details/38434179 Sub random_test() Dim RndNumber, temp(20), i, k, Maxrec As Integer Dim myRange As Range 'Debug.Print Int((30 * Rnd) + 1) Set myRange = Workshe...
未完成--VBA---取不重复的随机数几个的一个案例
奔跑的犀牛先生
02-21 412
Function eeee111草稿() '这不行啊，还得去重随机 *权重*参数就行，这个好！ 随机整数，小数，和不放回 ,之后改把，这版先做简单得 ''' 合成得技能得去重啊，加参数标记也行！！！现在这样不去重肯定不行!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ''' 循环检查字典也许，字典key不够长就重新随到为止？效率不够高？ '每次随1个判断1次，是否和现有的重复，效率可能还可以 Dim dict2 A...
js取0-9随机取4个数不重复的数字代码实例
10-17
本文将详细讲解如何使用JavaScript实现从0到9的数字中随机选取四个不重复的数字，并提供相应的代码实例。 首先，我们需要创建一个空数组`arr_4`来存储这四个不重复的随机数。然后，定义一个名为`getRandom`的函数，...
VBS 生成不重复随机数代码[0-10]
09-05
在某些情况下，我们需要生成不重复的随机数，以避免重复的结果影响到我们的应用程序。 VBScript 中的随机数生成 VBScript 提供了多种方式来生成随机数，其中最常见的方法是使用 `Rnd` 函数。`Rnd` 函数可以生成一...
获取10-20之间六个不重复的随机整数.html
04-14
JavaScript获取10-20之间六个不重复的随机数，适合前端基础入门初学者和一些对前端感兴趣的编程小白以及在校计算机专业大学生
S7-300生成随机数.rar
01-06
生成随机数在工业控制中有多种用途，例如模拟真实世界的不确定性、进行测试与调试、或者在一些随机化决策过程中。在S7-300中，生成随机数通常通过编程实现，使用的是SIMATIC Step 7编程软件，它支持IEC 61131-3标准...
不重复抽奖VBA脚本
08-10
一个不重复抽奖的VBA脚本，可用于年会等活动，里面有源码和详细注释
取不重复的N个随机数
09-26
随机函数的用法，数组的用法，GOTO语句的用法
快速生成特定区间内的不重复随机数（随机打乱区间元素顺序）
04-08
通过移位和逻辑运算，快速生成给定区间的不重复随机数。 形象地说就是随机打乱值的顺序。 发现网上其它的方法都太慢了，又刚好想到这个方法， 就传上来了。
VB产生不重复的随机数
05-15
使用FSO对象的词典，可以利用词典的Exists方法判定新产生的随机数是否已经产生过：
生成不重复随机数
人生如路
01-09 949
利用C++中的bitset来检查生成的随机数是否重复。
vba随机抽取人名不重复_excel如何实现随机抽取且不重复
weixin_42347426的博客
01-30 4188
点击查看excel如何实现随机抽取且不重复具体信息答：方法一：公式法 1、我们以生成1-10范围内的随机数字为例，讲述方法。 首先，在A2单元格中输入公式：=SMALL(IF(COUNTIF($A$1:A1,ROW($1:$11))=0,ROW($1:$11)),INT(RAND()*(11-ROW(A1))+1)) 然后按下Ctrl+Shift+Enter三键结束数组公式。 2、然后，...答：...
EXCEL公式 VBA 随机生成不重复值
璀璨 - 帝禹
11-15 2325
宏代码 Sub 不重复的值() Dim arr(1 To 100000, 1 To 1), dic Set dic = CreateObject("scripting.dictionary") Do Until i = 100000    tmp = Format(Int(Rnd() * 100000) + 1, 0)    If Not dic.exists(tmp) Then       i
VB生成十个不重复的数
weixin_45607215的博客
02-11 1165
错误写法： Private Sub Form_Click() Dim a(10) As Integer For i = 1 To 10 a(i) = Int(Rnd * 10) For j = i + 1 To 10 '错误的地方 If a(i) = a(j) Then i = i - 1 Next Next For i = 1 To 10 Print a(i); Next Print End Sub 正确写法.
生成每位不重复的随机数
u011843342的博客
10-19 340
面试常见题目。如果是生成100个不重复的随机数，可以用HashSet，或者辅助数组 如果是生成每位都不同的随机数， 方法就是将一个有序数组进行打乱，然后从这个被打乱的有序数组里取连续位置乘10—因为每个数都是不同的，它们被打乱一次后，连续取出，也是不同的。 当首位不为0（在valueof时已经被舍弃掉了，很显然result作为一个整数变量是不允许首位是0的），但最后一个数组array[i]=0时，不满足6位所以最后结果乘以10即可，要么重复执行。 public static int N...
VBA编程：创建不重复随机数生成器(1-10000范围内)
本篇VBA代码是一个名为“生成不重复的随机数”的子程序，用于在Microsoft Excel中创建不重复的随机数序列。该程序主要用于在一个指定的范围内（由用户输入的最小值、最大值和随机数的精度决定）生成指定数量的随机数...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值