Excel用VBA批量生成不重复的指定范围的固定不变的随机数（提供生成文档下载）

在 excel 中，如果批量生成不重复的随机，用公式不容易做到，但用 VBA 却很容易实现。VBA 生成随机数十分灵活，可满足生成多种要求的随机数，例如：可以大批量生成不限定范围的小数或整数随机数、指定范围的小数或整数随机数（包括负数）。

用 VBA 生成随机数通常分为两步，一步是创建窗体和添加控件，另一步是编写代码，如果不要求在窗体上操作，直接编辑代码即可，但灵活度没那么大。以下列举了两用 VBA 生成随机数的实例，一个功能简单，另一个功能多、能大批量生成满足多种要求的随机数，它们都提供生成文档下载。

一、Excel用VBA批量生成指定行数和列数的固定不变的小数随机数

（一）创建窗体和添加控件

1、创建窗体。在 Excel 窗口，按 Alt + F11 打开 VBA 编辑窗口，单击“插入”，在弹出的菜单中选择“用户窗体”，新建一个用户窗体；单击“属性”小窗口中“(名称)”右边的输入框，选中里面的文字，输入 ufRand 作为窗体名称；再单击 Caption 右边的输入框，选中里面的文字，输入“生成随机数”作为窗体的名称。

2、添加标签和文本框控件。

A、单击一下新建的窗体，在它左边显示“工具箱”，把鼠标移到大写字母 A 上，按住左键并拖到窗体，则添加一个标签控件；把它的“名称”改为 lblRows，再把它的 Caption 改为“行数”；单击 Font 右边的输入框，再单击输入框右边出的“...”按钮，打开“字体”窗口，“大小”选择“小四”，单击“确定”，把标签的字体设置为“小四”；

B、同样方法把一个文本框控件（有 ab| 的哪个）拖到窗体，把它的“名称”改为 tbRows，把它的字体也设置为“小四”。

C、按住 Shift，单击“行数”标签，把它们选中，按 Ctrl + C 复制，再按 Ctrl + V 粘贴，把“行数和文本框”复制一份；单击窗体空白处释放副本的选中状态，选中复制的“行数”，把它的“名称”改为 lblCols、Caption 改为“列数”；再选中复制的文本框，把“名称”改为 tbCols。

3、添加按钮。单击一下“生成随机数”窗体，把一个按钮控件拖到窗体，把它的“名称”改为 btnSubmit、Caption 改为“提 交”，再它把的字体设置为“小四”；单击一下窗体空白处，再选中按钮，按 Ctrl + C 复制，再按 Ctrl + V 把按钮粘贴一份，选中粘贴的按钮，把它的“名称”改为 btnConser，再把它的 Caption 改为“取 消”。操作过程步骤，如图1所示：

图1

（二）给按钮添加代码并生成随机数

1、给按钮添加代码。双击“提 交”按钮，打开代码输入窗口，把以下代码

Dim rowNum As Integer
Dim colNum As Integer

'把输入的行数和列数转为整型后分别赋给 rowNum、colNum
rowNum = Val(tbRows.Text)
colNum = Val(tbCols.Text)

For i = 1 To rowNum
   For c = 1 To colNum
      '把生成的随机数赋给第 i 行第 c 列的单元格
      Cells(i, c) = Rnd()
   Next
Next

复制到

Private Sub btnSubmit_Click()

End Sub

之间，双击 ufRand 返回“生成随机数”窗体，双击“取 消”按钮，把 Unload Me 复制到

Private Sub btnConser_Click()

End Sub

之间。

2、生成随机数。单击“运行”，选择“运行子过程/用户窗体”，打开“生成随机数”窗口，并切换到 Excel 窗口，“行数”输入 8，“列数”输入 3，单击“提 交”，则生成 8 行 3 列的随机数；单击“取 消”，结束代码运行；操作过程步骤，如图2所示：

图2

3、代码说明：

A、Dim 用于定义变量，Dim rowNum As Integer 是把 rowNum 定义为整型，colNum 也被定义为整型。

B、Val() 函数用于把文本转为整型，Val(tbRows.Text) 把输入的“行数”转为整型。

C、For To Next 为循环语句，代码中使用了两 For 循环，其中外层循环（For i = 1 To rowNum）用于控制要生成随机数的行数，内层循环（For c = 1 To colNum）用于控制每行生成几列随机数。

4、下载以上生成随机数的 Excel 文件：.xlsx 版（Excel 2007 以上版本），.xls 版（Excel 2003 版）。下载后，用 Excel 打开，按Alt + F11 切换到 VBA 编辑窗口，单击窗口左边的“窗体”把它展开，再单击 ufRand 显示窗体，按 F5 运行即可。

二、Excel用VBA自定义批量生成绝对不重复的随机数

（一）生成随机数演示

1、生成 0 到 1 的指定行数和列数的不重复的小数随机数。在 Excel 窗口，按 Alt + F11 切换到 VBA 编辑窗口，单击“运行子过程/用户窗体”的“绿色三角”图标（或按 F5）执行代码，打开“生成随机数”窗口并切换回 Excel 窗口。在“起始行和起始列”都输入 2，“行数”输入 100，“列数”输入 10，单击“提交”，则生成 1000 个 0 到 1 的小数随机数。操作过程步骤，如图3所示：

图3

2、生成保留两位小数的不重复的随机数。单击“清除”把上次生成的随机数删除，“起始行和起始列”都改为 1，“行数和列数”都改为 4，勾选“生成小数随机数”，“小数位数”输入 2，单击“提交”，则生成 16 个保留两位小数的随机数。勾选“生成指定范围的随机数”，“起始值”输入 0.5，“结束值”输入 1.8，单击“提交”，则生成 16 个 0.5 到 1.8 的保留两位小数的随机数。操作过程步骤，如图4所示：

图4

3、生成指定范围、行数和列数的不重复的整数随机数。在“起始行和起始列”都输入 1，“行数”和“列数”都输入 10，勾选“生成指定范围的随机数”，“起始值”输入 100，“结束值”输入 200，单击“提交”，则生成 100 个 100 到 200 的整数随机数；把“起始值”改为 -100，“结束值”不变，“单击“提交”，则生成 100 个 -100 到 200 的整数随机数。操作过程步骤，如图5所示：

图5

提示：一次能生成随机数的数量与电脑内存有关，如果电脑内存在 8 GB 以上，一次能生成 100 万个以上；另外，运行代码前要选中窗体或在代码编辑窗口，不能选中单个控件运行，这样会发生错误。

（二）创建窗体和添加控件

像上例一样创建窗体与添加控件，它们的“名称”和 Caption 分别如下：

“起始行”标签：lblStartRow

“起始行”文本框：tbStartRow

“起始列”标签：lblStartCol

“起始列”文本框：tbStartCol

“行数”标签：lblRowNum

“行数”文本框：tbRows

“列数”标签：lblCols

“列数”文本框：tbCols

“生成指定范围的随机数”复选框：cbRandBetween

“生成小数随机数”复选框：cbFloatRand

“小数位数”标签：lblDeciPlace

“小数位数”文本框：tbDeciPlace

“起始值”标签：lblMinValue

“起始值”文本框：tbMinValue

“结束值”标签：lblMaxValue

“结束值”文本框：tbMaxValue

“提交”按钮：btnSubmit

“取消”按钮：btnCancel

“清除”按钮：btnClear

“生成进度”标签：lblProgressText

“当前生成数目”标签：lblProgress

“错误提示”标签：lblErrorr

（三）给按钮控件添加代码

1、单击一下“窗体”，右键 ufRandBetween（如果“工具箱”遮挡了 ufRandBetween，单击一下“属性”窗口以把“工具箱”隐藏），在弹出的菜单中选择“查看代码”，打开代码编辑窗口，把以下代码复制过去：

Public flag As Boolean
Private Sub btnCancel_Click()
  flag = True
  Unload ufRandBetween
End Sub

Private Sub btnClear_Click()
  Cells.Clear
End Sub

Private Sub btnSubmit_Click()
   Dim startRow As Integer: startRow = 1 '起始行
   Dim rowNum As Long '行数
   
   Dim startCol As Integer: startCol = 1 '起始列
   Dim colNum As Integer '列数

   If tbStartRow.Text <> "" Then
     If Not IsNumeric(tbStartRow.Text) Then
       lblError.Caption = "起始行必须为数字！"
       Exit Sub
     End If

      startRow = CInt(tbStartRow.Text)
   End If
   
   If tbRows.Text = "" Then
      lblError.Caption = "行数不能为空！"
      Exit Sub
   End If
   If Not IsNumeric(tbRows.Text) Then
      lblError.Caption = "行数必须为数字！"
      Exit Sub
   End If
   rowNum = CLng(tbRows.Text)
   
   If tbStartCol.Text <> "" Then
      If Not IsNumeric(tbStartCol.Text) Then
        lblError.Caption = "起始列必须为数字！"
        Exit Sub
      End If
      startCol = CInt(tbStartCol.Text)
   End If
   
   If tbCols.Text = "" Then
      lblError.Caption = "列数不能为空！"
      Exit Sub
   End If
   If Not IsNumeric(tbCols.Text) Then
      lblError.Caption = "列数必须为数字！"
      Exit Sub
    End If
   colNum = CInt(tbCols.Text)
   
   If startRow <= 0 Then
      startRow = 1
   End If
   If startCol <= 0 Then
      startCol = 1
   End If

   Dim realRowNum As Long '实际行数
   Dim realColNum As Integer '实际列数
   
   realRowNum = rowNum + startRow - 1 '计算实际行数
   realColNum = colNum + startCol - 1
   
   Dim minValue As Double: minValue = 1 '指定范围起始值
   Dim maxValue As Double '指定范围结束值
   
      Dim strMsg As String: strMsg = " 你可以减少行数或列数，或增加小数位数。"
   Dim decimalPlace As Long: decimalPlace = 0
   
   Dim exMultiples As Long: exMultiples = 1 '扩大倍数
   If (cbRandBetween.Value Or cbFloatRand.Value) And tbDeciPlace.Text <> "" Then
      If Not IsNumeric(tbDeciPlace.Text) Then
         lblError.Caption = "小数位数必须为数字！"
         Exit Sub
      End If
      decimalPlace = CLng(tbDeciPlace.Text)
      exMultiples = GetMultiplesAsDecimalPlaces(decimalPlace)
   End If

   If cbRandBetween.Value Then
      If tbMinValue.Text <> "" Then
         If Not IsNumeric(tbMinValue.Text) Then
            lblError.Caption = "起始值必须为数字！"
            Exit Sub
         End If
         minValue = CDbl(tbMinValue.Text)
      End If

      If Not IsNumeric(tbMaxValue.Text) Then
        lblError.Caption = "结束值必须为数字！"
        Exit Sub
      End If
      maxValue = CDbl(tbMaxValue.Text)
            
      If maxValue < minValue Then
        lblError.Caption = "结束值必须大于起始值！"
        Exit Sub
      End If
      If cbFloatRand.Value Then
         If tbDeciPlace.Text = "" Then
            decimalPlace = 2
            exMultiples = GetMultiplesAsDecimalPlaces(decimalPlace)
         End If
         
         If (maxValue - minValue) * exMultiples + 1 < rowNum * colNum Then
            lblError.Caption = "指定范围内的数字总数应该大于等于 " & rowNum * colNum & "。" & strMsg
            Exit Sub
         End If
      Else
         If maxValue - minValue + 1 < rowNum * colNum Then
            lblError.Caption = "指定范围内的数字总数应该大于等于 " & rowNum * colNum & "。" & strMsg
            Exit Sub
         End If
      End If
   Else
      If decimalPlace > 0 Then
          If exMultiples < rowNum * colNum Then
            lblError.Caption = "保留的小数位数范围内能生成的随机数个数必须大于等于 " & rowNum * colNum & "。" & strMsg
            Exit Sub
          End If
       End If
   End If
   
   If lblError.Caption <> "" Then
      lblError.Caption = ""
   End If
         

   flag = False
   Dim arr() As Double
   
   If lblProgressText.Caption = "保存进度：" Then
     lblProgressText.Caption = "生成进度："
   End If
   
   Call CreateRand(cbRandBetween.Value, cbFloatRand.Value, decimalPlace, rowNum, colNum, minValue, maxValue, arr, lblProgress)
   lblProgressText.Caption = "保存进度："
   Call OutputRand(arr, startRow, startCol, realRowNum, realColNum, lblProgress)
End Sub
'根据小数位数返回相应的倍数
Private Function GetMultiplesAsDecimalPlaces(decimalPlace As Long) As Long
   If decimalPlace <= 0 Then
      GetMultiplesAsDecimalPlaces = 0
     Exit Function
   End If
   
   GetMultiplesAsDecimalPlaces = 1
   Dim i As Integer
   For i = 0 To decimalPlace - 1
      GetMultiplesAsDecimalPlaces = GetMultiplesAsDecimalPlaces * 10
   Next
End Function

'生成随机数
'isRanBetween 是否生成指定范围的随机数，isFloatRand 是否生成小数随机数
'rowNum 行数，colNum 列数, minValue 起始值，maxValue 结束值
Private Sub CreateRand(isRanBetween As Boolean, isFloatRand As Boolean, decimalPlace As Long, rowNum As Long, colNum As Integer, minValue As Double, maxValue As Double, ByRef arr() As Double, lblProgress As Object)
   Randomize (Timer)
   Dim isEnd As Boolean
   isEnd = True

   Dim totalCells As Long
   Dim i As Long
   Dim randomType As Integer
   
   totalCells = rowNum * colNum
   ReDim Preserve arr(0 To totalCells - 1)
   
   If isRanBetween Then
        If isFloatRand Then
            randomType = 1
         Else
            randomType = 2
         End If
     Else
        If isFloatRand And decimalPlace > 0 Then
           randomType = 3
        Else
           randomType = 4
        End If
     End If

   For i = 0 To totalCells - 1
     isEnd = GeneratorRandomNoDuplicates(randomType, minValue, maxValue, decimalPlace, i, arr)
     If flag Then Exit For
     
     If CLng(i / 100) >= 1 And i Mod 100 = 0 Then
        DoEvents
        lblProgress.Caption = i
     End If
     If flag Then Exit For
   Next
   lblProgress.Caption = i
End Sub
'生成不重复的随机数
Private Function GeneratorRandomNoDuplicates(n As Integer, minValue As Double, maxValue As Double, decimalPlace As Long, i As Long, ByRef arr() As Double) As Boolean
   Dim temp As Variant
   Dim isEnd As Boolean
   isEnd = True
   Dim bAseNum As Double: bAseNum = 10000000
   
   Do While (isEnd)
       If n = 1 Then '生成指定范围的小数随机数
           temp = WorksheetFunction.Round(WorksheetFunction.RandBetween(minValue * bAseNum, maxValue * bAseNum) / bAseNum, decimalPlace)
       ElseIf n = 2 Then '生成指定范围的整数随机数
           temp = Int(Rnd * (maxValue - minValue + 1) + minValue)
       ElseIf n = 3 Then '生成保留指定小数位数的随机数
           temp = WorksheetFunction.Round(Rnd, decimalPlace)
        Else '生成小数随机数
           temp = Rnd
       End If
       isEnd = IsDuplicateRandom(temp, arr)
       If isEnd = False Then
          arr(i) = temp
       End If
   Loop
End Function

'检查当前生成的随机数是否重复
Private Function IsDuplicateRandom(randNum As Variant, ByRef arr() As Double) As Boolean
    Dim i As Long
    i = UBound(arr)
    IsDuplicateRandom = False
    
    For j = 0 To i
       If arr(j) = randNum Then
          IsDuplicateRandom = True
          Exit For
        Else
            IsDuplicateRandom = False
        End If
     Next
End Function
'显示生成的随机数
'arr() 保存随机数的数组，startRow 起始行, startCol 起始列, rowNum 行数，colNum 列数
Private Sub OutputRand(ByRef arr() As Double, startRow As Integer, startCol As Integer, rowNum As Long, colNum As Integer, lblProgress As Object)
    If UBound(arr) > LBound(arr) Then
      Dim i As Long
      For r = startRow To rowNum
        For c = startColTo colNum
          If (i <= UBound(arr)) Then
            Cells(r, c) = arr(i)
            i = i + 1
            
            If CLng(i / 1000) >= 1 And i Mod 1000 = 0 Then
              DoEvents
              lblProgress.Caption = i
            End If
          End If
          If flag Then Exit For
        Next
        If flag Then Exit For
      Next
      lblProgress.Caption = i
      Erase arr
    End If
End Sub

操作过程步骤，如图6所示：

图6

（四）代码解析：

1、总体说明。

代码最前定义的 flag 为全局变量，用于终止生成随机数；btnCancel_Click() 是“取消”按钮的执行事件；Sub btnClear_Click 是“清除”按钮的执行事件；btnSubmit_Click() 是“提交”按钮的执行事件。

2、定义变量并初始化。

Dim startRow As Integer: startRow = 1 是把 startRow 定义为整型并把它初始化为 1。

3、If 语句。

“If 条件 Then 代码 End If”或“If 条件 Then 代码 Else 代码 End If”是判断语句，当条件为真时，执行 Then 后面的代码，否则执行 Else 后面的代码，如果没有 Else，则不执行。

4、输入检查。

为避免输入的内容导致代码执行错误，通常要检查输入的内容是否符合代码的执行规范。在这里，必须全输入数值，否则代码会产生错误，因此对每个文本框输入的内容都要检查是否为数值，以下就是检查“起始行”是否为数值的代码：

   If tbStartRow.Text <> "" Then
     If Not IsNumeric(tbStartRow.Text) Then
       lblError.Caption = "起始行必须为数字！"
       Exit Sub
     End If

由于把“起始行”的默认值设置为 1，因此不要求必须输入，所以只有“起始行”输入了文字才判断所输入的文字是否为数值，If tbStartRow.Text <> "" Then 用于检查“起始行”是否输入了文字，代码的意思是：如果“起始行”的文本框不等于空。

IsNumeric() 用于检查文字是否为数字，IsNumeric(tbStartRow.Text) 用于判断“起始行”文本框中输入的文字是否为数字。Not 用于表示 VBA 中的“非”运算， Not IsNumeric(tbStartRow.Text) 意思是：如果“起始行”文本框中输入的不是数字，则把 "起始行必须为数字！" 返回给用户。

5、类型转换

CInt() 用于把字符型转为整型，例如代码中的 startRow = CInt(tbStartRow.Text)，也可以 Val()，如 startRow = Val(bStartRow.Text)。

CLng() 用于把字符型转长整型，例如代码中的 rowNum = CLng(tbRows.Text)。

6、字符或字符串连接

VBA 用“与”符号 & 连接字符、字符串或变量，例如代码中的 lblError.Caption = "指定范围内的数字总数应该大于等于 " & rowNum * colNum & "。" & strMsg。

7、定义动态数组或参数

VBA 定义动态数组前需要先定义一个普通数组，然后再用 ReDim Preserve 把普通数组重新定义为动态数组，例如代码中的：

Dim arr() As Double
totalCells = rowNum * colNum
ReDim Preserve arr(0 To totalCells - 1)

0 To totalCells - 1 是动态数组的元素取值范围。如果把数组作为参数，定义时需要加址传递关键字 ByRef，例如代码中的 ByRef arr() As Double。

8、判断数组是否为空和取数组的长度

A、在 VBA 中，用数组的上界与它的下界比较判断它是否为空，如果上界小于下界，则数组为空，否则不为空；例如代码中的 If UBound(arr) > LBound(arr) Then，数组 arr 的上界大于它的下界，所以 arr 不为空。UBound() 函数用于取数组的上界，LBound() 用于取数组的下界。

B、取数组长度（即取数组有多少个元素）用 UBound(arr)，UBound(arr) 是取数组 arr 最后一个元素的下标，如果要取数组的实际元素个数还要加 1，即 UBound(arr) + 1。

9、释放数组占用的内存

数组使用结束后，要用 Erase arr 释放数组占用的内存，特别是数组元素比较多或内容比较多时，arr 是数组名称。

10、控件作为参数的定义

控件作为参数需要把它用 Object 定义为对象，例如代码中把“生成进度”标签控件 Label 作为参数定义为：lblProgress As Object。

11、制作进度条

A、显示程序执行进度可以用标签控件（即 Label），例如代码中用 lblProgress 实时显示已生成随机数个数与保存进度，代码如下：

    If CLng(i / 100) >= 1 And i Mod 100 = 0 Then
      DoEvents
      lblProgress.Caption = i
    End If

B、代码中 CLng(i / 100) 用 i 与 100 取整，当 i 小于 100 时，取整结果为 0，只有当 i 大于等于 100 时，取整结果才会大于等于 1，作用是每生成 100 个随机数才显示一次进度；i Mod 100 是用 i 与 100 取模，即取余数，作用是只有 i 为如 100 、200 这样的整数时才显示进度。

C、进度条代码中必须有 DoEvents（执行事件），否则进度不会变化。另外，循环结束后还要再赋一次，例如代码中的 

Next
lblProgress.Caption = i

否则进度也不会变化。

12、结束子过程（函数）与终止程序执行

A、结束子过程（函数）执行。以输入检查为例，当检查到输入的内容不符合规范时，用 Exit Sub 结束当前子过程的执行，例如代码中的：

If Not IsNumeric(tbStartCol.Text) Then
lblError.Caption = "起始列必须为数字！"
Exit Sub
End If

B、终止程序执行。当用 Unload Me 或 Unload +“窗体名称”关闭窗体时，如果程序未执行完（如循环未执行完），程序并不会终止执行，而是继续在后台往下执行，而前台返回给我们的是无响应，要终止程序的执行，需要终止未执行完的程序。如例中用变量 flag 作为是否取消程序执行的标志，如果用户单击了“取消”按钮，立即把 flag 设置为 True，循环中检测到 flag 为 True，立即用 Exit For 结果循环；代码如下：

Public flag As Boolean
Private Sub btnCancel_Click()
flag = True
Unload ufRandBetween
End Sub

If flag Then Exit For

13、清空所有单元格

用 VBA 清空 Excel 所有单元格可以用 Cells.Clear，它会清空单元格的内容和格式。

(五）下载 Excel 文件：.xlsx 版（Excel 2007 以上版本），.xls 版（Excel 2003 版）。下载后，用 Excel 打开，按 Alt + F11 切换到 VBA 编辑窗口，单击窗口左边的“窗体”把它展开，再单击 ufRandBetween 显示窗体，按 F5 运行即可。

提示：执行 VBA 代码需要勾选“启用所有宏”，方法为：文件 → 选项 → 信任中心 → 信任中心设置 → 宏设置 → 启用所用宏 → 确定。另外，保存时，“保存类型”要选择“Excel 启用宏的工作簿”。

版权声明：本文内容由网络用户投稿，版权归原作者所有，本站不拥有其著作权，亦不承担相应法律责任。如果您发现本站中有涉嫌抄袭或描述失实的内容，请联系我们jiasou666@gmail.com 处理，核实后本网站将在24小时内删除侵权内容。