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 IntegerX = 1For Y = 1 To 10Cells(Y, X) = RndNextFor Z = 1 To 10Cells(Z, X + 1) = Int(100 - 50 + 1)NextFor O = 1 To 10Cells(O, X + 2) = Int((100 - 50 + 1) * Rnd + 50)Next
End Sub

结果图例：

三、抽奖

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

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

本机测试：

Public Z As Integer
'测试用Z保留每次运行值
Public Sub rnd3()'Z = 0Dim i%, y%, x%Dim a(1 To 100) As StringDim a2(1 To 3)Dim R1 As Integeri = 1Do While Cells(i, 1) <> ""          'A列里面装入数组a(i) = Cells(i, 1)i = i + 1LoopFor y = 1 To 3a2(y) = Cells(y, 5)             '已有的名次装入数组Next'StopRandomize                               '刷新随机序列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                                       '刷新出来的值再比对下LoopNextZ = Z + 1                               '测试加行值Cells(Z, 7) = a(R1 + 1)                     '测试值
End Sub

结果图1:

结果图2:

四、指定几率/限定次数

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

例子：

本机测试：

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

测试结果：

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

本机测试：

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

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

五、随机凑数实例

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

先输入模拟数据：

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

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

Sub rnd5b()Dim b%, c%, d&, e&Dim P As Integer, q As SingleP = 0Dim 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 = 0Erase brr                       '重新匹配需清空ReDim brr(1 To b)                   '清空完需重定义For c = 1 To bIf Int(Rnd() * 2) > 0 Then          '随机装入brr(c) = arr(c, 1)                  '装入的数记录e = arr(c, 1) + e                   '不断求和End IfNextIf P > 1000 Then                        '设定一个循环数防止卡机MsgBox "超过次数"Exit DoEnd IfP = P + 1'StopLoopRange("B1:B20") = Application.WorksheetFunction.Transpose(brr)Range("B21").Value = Application.WorksheetFunction.Sum(brr)
End Sub

本机测试结果