本文于2023年8月29日首发于本人同名公众号，更多文章案例请搜索关注！
内容提要
考场座位安排
考生信息清空
大家好，我是冷水泡茶，今天在网上论坛看到一个求助贴，他的问题是：考生随机排位问题？
他的数据表是这样的，左边两列是考生姓名，右边几列是考场安排：
他的需求是：
（1）点击“抽签”能够将列B的”姓名“随机排在表内”姓名“中。
（2）考场及座次”以及考生人数不是固定数量，根据每场考试人数能够修改，即：可以修改成80人或者116人或者143人等等
（3）点击”清空“可以将表内的“姓名”清空
我不禁想到我们前期分享的案例【Excel VBA 学生考场安排/考生考场顺序打乱】中，有数组随机排序的自定义函数ShuffleArray，正好可以拿来一用，我们一起来看一下：
基本思路
1、把考生姓名读入数组，运用自定义数组乱序函数给它随机排序。
2、把考场座次安排区域考生姓名清空，做一个独立的清除数据的过程，正好满足他的“清空”数据的需求。
3、把考场及座次安排表数据区域读入数组arrResult。
4、循环考生数组，把考生姓名填入arrResult。
5、把数组arrResult数据填入工作表。
程序代码
1、模块1，Arrange，考场座次安排：
Sub Arrange() Dim ws As Worksheet Dim lastRow As Integer Dim arr() Dim arrResult() Set ws = ThisWorkbook.Sheets("Sheet1") Call clearData With ws lastRow = .UsedRange.Rows.Count arr = .Range("A4:B" & lastRow).Value arrResult = .Range("D4:Z28").Value For i = 1 To 3 arr = ShuffleArray(arr) Next For i = 1 To UBound(arr) arrResult((i - 1) Mod UBound(arrResult) + 1, 3 + Int((i - 1) / UBound(arrResult)) * 4) = arr(i, 2) Next .Range("D4").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult End WithEnd Sub
代码解析：
（1）定义一些变量，工作表对象ws，数组等。
（2）line7，调用clearData过程，先清空考场座次安排中考生姓名，以防考生减少后不能完全覆盖，有遗留数据，这就不好了。
（3）line10~11，把考生数据读入数组arr，考场座次表读入数组arrResult。
（4）line12~14，把arr数组的顺序打乱，这里套了一层循环，加深乱序的程度。
（5）line15~17，循环arr，把考生姓名填入数组arrResult，这里的关键是重复生成1~25的序列，用Mod求余的方法；生成一个固定间隔增长的序列，采用i除以25取整后乘以间隔数4，即每隔25个，就增加一个间隔。
（6）line18，把结果数组arrResult写入工作表。
2、模块1，clearData，清空姓名：
Sub clearData() Dim ws As Worksheet Dim arrResult() Dim lastCol As Integer Set ws = ThisWorkbook.Sheets("Sheet1") With ws lastCol = .UsedRange.Columns.Count For i = 1 To 25 For j = 6 To lastCol If (j - 2) Mod 4 = 0 Then .Cells(i + 3, j) = "" End If Next Next End WithEnd Sub
代码解析：
（1）定义一些变量，工作表对象ws，数组等。
（2）循环工作表行，列，把姓名列清空，这里在判断姓名列的时候，也用了一个Mod求余的方法，我们可以发现，姓名列在第6、10、14......列，我们可以用列号减去2再除以4，余数为0来判断，或者直接用列号除以4，余数为2来判断。
3、模块1，ShuffleArray，数据乱序自定义函数：
Function ShuffleArray(arr As Variant) As Variant Dim numRows As Long Dim randomArr() As Variant Dim shuffledArr() As Variant Dim i As Long, j As Long Dim tempRow As Long numRows = UBound(arr, 1) - LBound(arr, 1) + 1 ReDim randomArr(1 To numRows, 1 To 2) ReDim shuffledArr(LBound(arr, 1) To UBound(arr, 1), _ LBound(arr, 2) To UBound(arr, 2)) For i = 1 To numRows randomArr(i, 1) = i + LBound(arr, 1) - 1 ' 原始行号 randomArr(i, 2) = Rnd() ' 随机数 Next For i = 1 To numRows - 1 For j = i + 1 To numRows If randomArr(i, 2) > randomArr(j, 2) Then tempRow = randomArr(i, 1) randomArr(i, 1) = randomArr(j, 1) randomArr(j, 1) = tempRow tempRow = randomArr(i, 2) randomArr(i, 2) = randomArr(j, 2) randomArr(j, 2) = tempRow End If Next Next For i = LBound(arr, 1) To UBound(arr, 1) For j = LBound(arr, 2) To UBound(arr, 2) shuffledArr(i, j) = arr(randomArr(i - LBound(arr, 1) + 1, 1), j) Next Next ShuffleArray = shuffledArrEnd Function
代码解析：
（1）定义一个跟原来数组行数相同的随机数组，2列，第一列装原来的行号，第二列生成随机数，以及跟原来数据行列相同的中间数组。
（2）把随机数组按第二列排序。
（3）根据随机数组第一列的行号，把原数组的对应数据写入中间数组，达到打乱原来数组的顺序的目的。
Tips
1、数组乱序自定义函数。
2、Mod求余的方法，在一个固定数字区域内往复循环。
3、数组数据写入工作表的方法，Range("A1").Resize。
......
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！