标签: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
欢迎在下面留言,完善本文内容,让更多的人学到更完美的知识。