关于随机抽奖问题，比较麻烦的在于去重，即每个人只能抽到一次。
来看今天的案例。
案例：
从下图 1 中的男和女中各抽出 7 个不重复的人，组成一个新的组，放置在 D 列中。
效果如下图 2 所示。
解决方案：
1. 将光标放置到工作表名称处 --> 右键单击 --> 在弹出的菜单中选择“查看代码”
2. 在 VBE 中输入以下代码：
Sub Macro1_FillDColumn()
Dim i As Integer, j As Integer
Dim randomIndexA As Integer, randomIndexB As Integer
Dim usedIndexesA() As Integer, usedIndexesB() As Integer
Dim countA As Integer, countB As Integer
Dim allValuesA() As Variant, allValuesB() As Variant
' 初始化变量
countA = 0
countB = 0
ReDim usedIndexesA(1 To 7)
ReDim usedIndexesB(1 To 7)
ReDim allValuesA(2 To 15)
ReDim allValuesB(2 To 15)
j = 2 ' 起始输出到D2
' 收集A列的所有值
For i = 2 To 15
allValuesA(i) = Cells(i, 1).Value
Next i
' 收集B列的所有值
For i = 2 To 15
allValuesB(i) = Cells(i, 2).Value
Next i
' 随机选择A列的7个不重复数据
For i = 1 To 7
Do
randomIndexA = Int((15 - 2 + 1) * Rnd + 2) ' A2:A15
If Not IsInArray(randomIndexA, usedIndexesA) Then
countA = countA + 1
usedIndexesA(countA) = randomIndexA
Cells(j, 4).Value = allValuesA(randomIndexA) '将结果输出到D列
j = j + 1
Exit Do
End If
Loop
Next i
' 随机选择B列的7个不重复数据
For i = 1 To 7
Do
randomIndexB = Int((15 - 2 + 1) * Rnd + 2) ' B2:B15
If Not IsInArray(randomIndexB, usedIndexesB) Then
countB = countB + 1
usedIndexesB(countB) = randomIndexB
Cells(j, 4).Value = allValuesB(randomIndexB) '将结果输出到D列
j = j + 1
Exit Do
End If
Loop
Next i
End Sub
Function IsInArray(valToBeFound As Integer, arr As Variant) As Boolean
Dim element As Variant
'判断随机数是否重复
On Error GoTo ErrorHandler
IsInArray = False
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
ErrorHandler:
Exit Function
End Function
Sub ClearDColumns()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
' 清空D列
ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row).ClearContents
End Sub
3. 关闭 VBE --> 在 Excel 工具栏中选择“开发工具”-->“插入”-->“按钮（窗体控件）”
4. 在弹出的对话框中选择 ...FillDColumn 这个宏 --> 点击“确定”
5. 将控件的默认文本修改为“分组”。
6. 选中控件 --> 右键单击 --> 在弹出的菜单中选择“复制”
7. 将复制出来的控件文本修改为“清空”。
8. 选中“清空”按钮 --> 右键单击 --> 在弹出的菜单中选择“指定宏”
9. 在弹出的对话框中选择 ...ClearDColumns 宏 --> 点击“确定”。
为了确保分组结果没有重复，再设置一下高亮显示重复值。
10. 选中 D 列 --> 选择工具栏的“开始”-->“条件格式”-->“突出显示单元格规则”-->“重复值”
11. 点击“确定”。
设置完成了。点击“分组”按钮，按要求自动分组，点击“清空”则清空分组结果。
12. 将文件保存为 .xlsm 格式。
