通过VBA开发工具--插入切换按钮，双击后查看代码，把代码复制进去。B2单元格为合并的多个单元格。把人员信息放在sheet2第一列A2单元格，sheet2重命名为“名单”。sheet1的B2单元格滚动显示人员信息，M列为抽中的人员，通过对sheet2的B列添加数字1和排序，实现人员不会被重复抽中。程序使用的是随机函数，被抽中全是运气！下次使用时，记得把sheet2的B列的数字1清空。



Private Sub togglebutton1_click()
Dim i As Integer, j As Integer, k As Integer, n As Integer
i = 2
j = 2
n = WorksheetFunction.CountA(ThisWorkbook.Sheets(2).Range("A2:A9999"))
k = WorksheetFunction.Sum(ThisWorkbook.Sheets(2).Range("B2:B9999"))
If ToggleButton1.Value = True Then
ToggleButton1.Caption = "暂停"
Do
[B2] = ThisWorkbook.Sheets(2).Cells(WorksheetFunction.RandBetween(k + 2, n), 1).Value
DoEvents
Loop Until ToggleButton1.Value = False
Else
ToggleButton1.Caption = "开始"
Cells(Rows.Count, "M").End(xlUp).Offset(1, 0) = [B2].Value
i = 2
j = 2
If k > 0 Then j = k
Do While ThisWorkbook.Sheets(1).Cells(i, 13) <> ""
Do While ThisWorkbook.Sheets(2).Cells(j, 1) <> ""
Do While ThisWorkbook.Sheets(1).Cells(i, 13) = ThisWorkbook.Sheets(2).Cells(j, 1)
ThisWorkbook.Sheets(2).Cells(j, 2) = 1
ActiveWorkbook.Worksheets("名单").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("名单").Sort.SortFields.Add2 Key:=Range("B2:B9999"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("名单").Sort
.SetRange Range("A2:B9999")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Exit Do
Loop
j = j + 1
Loop
j = 2
i = i + 1
Loop
End If
End Sub