花了三个小时，做了一个自动排坐的程序和模板，自动匹配排座。效果如下图
座位模板
生成效果
源码：
Option Explicit
Type typData
NianJi As String
BanJi As String
XueHao As String
XingMing As String
ShiShiHao As String
ZuoWeiHao As Integer
WeiZhi As String
End Type
Sub ExamRoom()
Dim i As Integer
Dim j As Integer
Dim r(1 To 64) As Integer
Dim c(1 To 64) As Integer
Dim DataStr() As typData
Dim d As Object
' Dim Loc() As String
' Dim MaxNum() As Integer
Dim Loc
Dim MaxNum
Dim LocCount As Integer
Dim cnt As Integer
Dim Has As Boolean
Dim rng As Range
Dim wb As Workbook
Dim osht As Worksheet
Dim sht As Worksheet
LocCount = 0
Set osht = ActiveSheet
For i = 1 To 64
For Each rng In Worksheets("64人").UsedRange
If rng.Value = "空座" & i Then
r(i) = rng.Row
c(i) = rng.Column
End If
Next rng
Next i
Set d = CreateObject("scripting.dictionary")
cnt = Cells(65536, 1).End(xlUp).Row - 2
ReDim DataStr(0 To cnt)
ReDim MaxNum(0 To 0)
ReDim Loc(0 To 0)
For i = 1 To cnt
DataStr(i).NianJi = Cells(i + 2, 1)
DataStr(i).BanJi = Cells(i + 2, 2)
DataStr(i).XueHao = Cells(i + 2, 3)
DataStr(i).XingMing = Cells(i + 2, 4)
DataStr(i).ShiShiHao = Cells(i + 2, 6)
DataStr(i).ZuoWeiHao = Cells(i + 2, 7)
DataStr(i).WeiZhi = Cells(i + 2, 8)
d(DataStr(i).WeiZhi) = d(DataStr(i).WeiZhi) + 1
' Has = False
' For j = 0 To UBound(Loc)
' If Loc(j) = DataStr(i).WeiZhi Then
' MaxNum(j) = MaxNum(j) + 1
' Has = True
' Exit For
' End If
' Next j
' If Has = False Then
' ReDim Preserve Loc(0 To UBound(Loc))
' ReDim Preserve MaxNum(0 To UBound(MaxNum))
' Loc(UBound(Loc)) = DataStr(i).WeiZhi
' MaxNum(UBound(MaxNum)) = 1
' End If
Next i
Loc = d.keys
MaxNum = d.items
Sheets(Array("40人", "48人", "56人", "64人")).Copy
Set wb = ActiveWorkbook
wb.Worksheets("40人").Range("3:3,7:7,11:11,15:15,19:19,23:23,27:27,31:31").ClearContents
wb.Worksheets("48人").Range("3:3,7:7,11:11,15:15,19:19,23:23,27:27,31:31").ClearContents
wb.Worksheets("56人").Range("3:3,7:7,11:11,15:15,19:19,23:23,27:27,31:31").ClearContents
wb.Worksheets("64人").Range("3:3,7:7,11:11,15:15,19:19,23:23,27:27,31:31").ClearContents
For i = 0 To UBound(Loc)
If MaxNum(i) <= 40 Then
wb.Sheets("40人").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Loc(i)
End If
If MaxNum(i) <= 48 And MaxNum(i) > 40 Then
wb.Sheets("48人").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Loc(i)
End If
If MaxNum(i) <= 56 And MaxNum(i) > 48 Then
wb.Sheets("56人").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Loc(i)
End If
If MaxNum(i) <= 64 And MaxNum(i) > 56 Then
wb.Sheets("64人").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Loc(i)
End If
If MaxNum(i) > 64 Then
MsgBox Loc(i) & "安排学生数量超过64！"
Exit Sub
End If
Next i
For i = 1 To cnt
wb.Worksheets(DataStr(i).WeiZhi).Cells(r(DataStr(i).ZuoWeiHao), c(DataStr(i).ZuoWeiHao)) = DataStr(i).XueHao & DataStr(i).XingMing
If DataStr(i).ZuoWeiHao = 1 Then
wb.Worksheets(DataStr(i).WeiZhi).Cells(1, 1) = "（" & DataStr(i).NianJi & "）年级第一次月考（" & Format(DataStr(i).ShiShiHao, "00") & "）试室"
End If
Next i
Application.DisplayAlerts = False
wb.Sheets(Array("40人", "48人", "56人", "64人")).Delete
Application.DisplayAlerts = True
MsgBox "输出完毕！"
End Sub
