花了三個小時，做了一個自動排坐的程序和模板，自動匹配排座创泄。效果如下圖
座位模板
生成效果
源碼：
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) & "安排學(xué)生數(shù)量超過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
