VBA自定义函数:在单元格区域中创建不重复的随机数

2024-03-11 11:10:39 浏览数 (1)

标签:VBA,自定义函数

有时候,我们需要创建一组不重复的随机组,例如在指定单元格区域中创建一组不重复的随机数用于模拟数据分析。

下面的一个VBA自定义函数,可用于创建指定数值范围的不重复随机数。代码如下:

代码语言:javascript复制
Function   RandomSeq(MinValue, MaxValue)
 Dim Seed As Double              '随机生成的种子数
 Dim NumberOfRandoms As Long     '要选择的随机值数目 (默认为全部)
 Dim TempArray_Source()          '保存最小值到最大值的源列表
 Dim TempArray_Result()          '保存随机选择的结果 (随机排序)
 Dim SrcULimit As Long           '源数组的上限. 用于消除重复
 Dim UsedSourceNo As Long        '从源数组中随机选择. 用于消除重复
 Dim Result_Index As Integer
 Dim i As Integer
 Dim TempValue As Integer
 
 Application.ScreenUpdating = False
 
 Randomize
 Seed = Int(Rnd * 1000000)
 NumberOfRandoms = (MaxValue - MinValue   1)
 
 If MinValue > MaxValue Then
   MsgBox "范围的下限超过了上限!"
   Exit Function
 End If
 
 If NumberOfRandoms = 0 Then
   MsgBox "没有要求返回任何数值!"
   Exit Function
 End If
 
 If NumberOfRandoms > (MaxValue - MinValue   1) Then
   MsgBox "要求返回的数字超过给定范围内的可能数量!"
   Exit Function
 End If
 
 ReDim TempArray_Source(MinValue To MaxValue, 1 To 1)
 ReDim TempArray_Result(1 To NumberOfRandoms, 1 To 1)
 
 For i = MinValue To MaxValue
   TempArray_Source(i, 1) = i
 Next i
 
 SrcULimit = UBound(TempArray_Source)
 
 Rnd -Seed '用种子数启动随机数生成器
 
 For Result_Index = LBound(TempArray_Result) To UBound(TempArray_Result)
   TempValue = Int((SrcULimit - MinValue   1) * Rnd   MinValue)
   TempArray_Result(Result_Index, 1) = TempArray_Source(TempValue, 1)
   UsedSourceNo = TempArray_Source(TempValue, 1)
   TempArray_Source(TempValue, 1) = TempArray_Source(SrcULimit, 1)
   TempArray_Source(SrcULimit, 1) = UsedSourceNo
   SrcULimit = SrcULimit - 1
 Next Result_Index
 
 Application.ScreenUpdating = True
 RandomSeq = TempArray_Result
End Function

要在单元格区域A1:A10000中创建从1至10000之间的不重复随机数,调用RandomSeq函数并实现目标的代码如下:

代码语言:javascript复制
Sub RandomSeq_Example_Usage()
 Dim TestArray()
 Dim DestRange As Range
 Dim min As Long
 Dim max As Long
 min = 1
 max = 10000
 TestArray = RandomSeq(min, max)
 Set DestRange = Range("A1:A" & (max - min   1))
 DestRange.Value = TestArray
End Sub

欢迎在下面留言,完善本文内容,让更多的人学到更完美的知识。

0 人点赞