VBA18随机函数RND例子(抽奖、指定几率、随机凑数)

一、函数说明(RND、INT、FIX)

官方说明：返回包含伪随机数的 Single 。

RNG函数属于VBA函数。用法有点类似于工作表的RAND函数

官方语法说明参考：

Rnd [ (数字) ]

可选的 Number参数 是 Single 或任何有效的 数值表达式。

返回值

如果 Number 为	则 Rnd 生成
小于 0	每次使用相同的数字，使用 Number 作为 种子。
大于 0	伪随机序列中的下一个数字。
等于 0	最近生成的数字。
未提供	伪随机序列中的下一个数字。

备注

Rnd 函数返回一个小于 1 但大于或等于 0 的值。

Number 的值确定 Rnd 如何生成伪随机数：

• 对于任何给定的原始种子，由于对 Rnd 函数的每个后续调用会将之前的数字用作序列中的下一个数字的种子，因此，将生成相同的数字序列。
• 在调用 Rnd 之前，请使用不带参数的 Randomize 语句，使用基于系统计时器的种子初始化随机数生成器。

 

若要生成给定范围中的随机整数，使用此公式：

 

Int((最大值 - 最小值 + 1) * Rnd + 最小值)

生成的随机数大概是小数点后15位数的一个数值，基本上日常使用是足够的。但如果是抽奖之类最好加入Randomize语句或Randomize Timer 使用(sub开始的随机序列在某个版本在第一次运行的时候是固定的)

注：

Randomize语句是用于初始化随机数生成器的语句。如果不使用Randomize语句，则每次调用Rnd函数时，都会使用相同的种子值，从而生成相同的随机数序列。

Timer函数返回当前系统时间，以秒为单位。在使用Randomize语句时，如果不提供number参数，则使用Timer函数返回的值作为新的种子值。

INT函数

Int 函数返回小于或等于指定数字的最大整数。

FIX函数

Fix 函数返回与指定数字最接近的整数。如果指定数字为正，则 Fix 函数返回小于或等于该数字的最大整数；如果指定数字为负，则 Fix 函数返回大于或等于该数字的最小整数。

官方函数说明地址 <Rnd 函数 (Visual Basic for Applications) | Microsoft Learn>

二、指定生成随机区间范围

Int((最大值 - 最小值 + 1) * Rnd + 最小值)

公式拆解：

(最大值-最小值+1)生成一个你要的范围求和个数，例如:100-50=50，+1是加上基础个数故这个范围就是51个

*RND 生成的随机数是0-1之间，可以看做是一个随机的百分比区间，乘以51再去除小数点（int）之后能得到的数值就是0-50，再加上最小值50就是50-100得到我们想要的区间

本机测试：

Sub rnd1()
    Dim X%, Y%, Z%, O%
    Dim Value1 As Integer
    X = 1
    For Y = 1 To 10
        Cells(Y, X) = Rnd
    Next
    For Z = 1 To 10
        Cells(Z, X + 1) = Int(100 - 50 + 1)
    Next
    For O = 1 To 10
        Cells(O, X + 2) = Int((100 - 50 + 1) * Rnd + 50)
    Next
End Sub

结果图例：

三、抽奖

场景模拟是A列下有人员名单。现要一个个抽奖(从第三名到第一名)。抽出来的人不能重复。

思路是将A列名单装入数组。统计人员个数做随机数。已抽到奖项的也做数组(用来对比如重复情况下则重新刷新随机数直至不同人员)

本机测试：

Public Z As Integer
'测试用Z保留每次运行值
Public Sub rnd3()
    'Z = 0
    Dim i%, y%, x%
    Dim a(1 To 100) As String
    Dim a2(1 To 3)
    Dim R1 As Integer
        i = 1
    Do While Cells(i, 1) <> ""          'A列里面装入数组
        a(i) = Cells(i, 1)
            i = i + 1
    Loop
    For y = 1 To 3
        a2(y) = Cells(y, 5)             '已有的名次装入数组
    Next
    'Stop
    Randomize                               '刷新随机序列
    R1 = Int((i - 2 - 1 + 1) * Rnd + 1)
    For x = 3 To 1 Step -1                      '对比是否重复
        Do While a(R1 + 1) = a2(x)
           ' MsgBox "重复名单，重新赋值"
            R1 = Int((i - 2 - 1 + 1) * Rnd + 1)         '重复则刷新
            x = 3                                       '刷新出来的值再比对下
    Loop
    Next
        Z = Z + 1                               '测试加行值
    Cells(Z, 7) = a(R1 + 1)                     '测试值
End Sub

结果图1:

 结果图2:

四、指定几率/限定次数

场景模拟是那像排列用视觉效果排列抽奖但实际几率不一的情况，思路是分配好几率用RND得出来的数做select case。

例子：

 本机测试：

   

   Sub rnd4()
        Dim L%
        Dim R2 As Integer
        Dim Str2 As String
        For L = 1 To 100
            Randomize                       '刷新随机序列
        R2 = Int((100 - 1 + 1) * Rnd + 1)
            Select Case R2                  '用CASE分配刷新出来的数分配几率
                Case Is = 1
                    Str2 = "屠龙刀"
                Case Is < 10
                    Str2 = "极品装备"
                Case Is < 40
                    Str2 = "平平无奇装备"
                Case Else
                    Str2 = "安慰奖"
            End Select
        Cells(L, 2) = Str2
        Next
    End Sub

测试结果：

 

        在例子上加入限定道具抽到的次数。思路是做一个模块变量做运行后一直保存的变量写入次数，每次抽到对应项目扣除减数，为0时则都转变为"安慰奖"

 本机测试：

Public r4%, r5%, r6%
Public Sub rnd4a()          '加入次数变量
    r4 = 1
    r5 = 9
    r6 = 30
End Sub
    Sub rnd4b()
        Dim L%
        Dim R2 As Integer
        Dim Str2 As String
        For L = 1 To 100
            Randomize                       '刷新随机序列
        R2 = Int((100 - 1 + 1) * Rnd + 1)
            Select Case R2                  '用CASE分配刷新出来的数分配几率
                Case Is = 1
                    If r4 Then                  '如果抽到对应的先看次数是否为0
                    r4 = r4 - 1
                    Str2 = "屠龙刀"             '不为0则正常出
                    Else
                    Str2 = "安慰奖"             '为0则转为安慰奖
                    End If
                Case Is < 10
                    If r5 Then
                    r5 = r5 - 1
                    Str2 = "极品装备"
                    Else
                    Str2 = "安慰奖"
                    End If
                Case Is < 40
                    If r6 Then
                    r6 = r6 - 1
                    Str2 = "平平无奇装备"
                    Else
                    Str2 = "安慰奖"
                    End If
                Case Else
                    Str2 = "安慰奖"
            End Select
        Cells(L, 2) = Str2
        Next
    End Sub

        本机上测试基本上100次之后全是安慰奖。

五、随机凑数实例

场景模拟是订单数量或者金额需凑到一定数凑整，用数组随机相加的和不断循环的方式来得出一个接近的数字并列举出分别是哪些数量。

先输入模拟数据：

Sub rnd5a()             '创建模拟数据
    Dim a5%
    Randomize
    For a5 = 1 To 20
        Cells(a5, 1) = Fix((100 - 1 + 1) * Rnd + 1) * 100
    Next
End Sub

'本机测试的是随机100-10000的数。总和大概10W左右。测试设定50000求和数,误差1%

Sub rnd5b()
    Dim b%, c%, d&, e&
    Dim P As Integer, q As Single
    P = 0
    Dim arr()                           '定义数组装原始数据
    Dim brr()                           '定义数组装匹配上的数据
        arr = Range("A1:a20")
    b = UBound(arr()) - LBound(arr()) + 1       '元素个数同原始数组
    d = Cells(2, 4)                     '设定求和总数
    q = Cells(2, 5)                     '误差率
        Randomize                               '开启随便种子
        Do While Abs(d - e) > d * q         '达不到我们想要的则重匹配
            e = 0
            Erase brr                       '重新匹配需清空
            ReDim brr(1 To b)                   '清空完需重定义
            For c = 1 To b
                If Int(Rnd() * 2) > 0 Then          '随机装入
                brr(c) = arr(c, 1)                  '装入的数记录
                e = arr(c, 1) + e                   '不断求和
                End If
            Next
            If P > 1000 Then                        '设定一个循环数防止卡机
            MsgBox "超过次数"
            Exit Do
            End If
                P = P + 1
                'Stop
        Loop
    Range("B1:B20") = Application.WorksheetFunction.Transpose(brr)
    Range("B21").Value = Application.WorksheetFunction.Sum(brr)
End Sub

本机测试结果