本文于2023年9月30日首发于本人同名公众号，更多文章案例请搜索关注！
内容提要
考场座位安排（用户窗体版）完整代码
1、在UserForm1里，窗体初始化过程：
Dim arr()Dim clsTxB As New TextBoxEventHandlerDim txtBox As ObjectDim textBoxes As CollectionDim btnTop As IntegerPrivate Sub UserForm_Initialize() Dim ws As Worksheet Dim lastRow As Integer Dim lastCol As Integer Set ws = ThisWorkbook.Sheets("数据") total = 0 With ws .Activate lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count arr = .Range(.Cells(2, 1), Cells(lastRow, lastCol)).Value For i = 1 To UBound(arr) If arr(i, 2) <> "" Then total = total + 1 End If Next End With btnTop = Me.LbTitle1.top + Me.LbTitle1.Height + 5 Set lbctrl = Me.FrmHeader.Controls.Add("Forms.Label.1", "topLb_1", True) With lbctrl .Caption = "第" & Mid(.Name, InStr(.Name, "_") + 1) & "考场" .Width = 40 .TextAlign = 2 .left = Me.LbTitle1.left .top = btnTop End With Set txtBox = Me.FrmHeader.Controls.Add("Forms.TextBox.1", "topTb_1", True) With txtBox .Width = 30 .left = Me.LbTitle2.left .top = btnTop End With clsTxB.ReceiveTextbox txtBox If textBoxes Is Nothing Then '将 TextBoxEventHandler 对象添加到集合中 Set textBoxes = New Collection End If textBoxes.Add clsTxB Set clsTxB = Nothing Set txtBox = Me.FrmHeader.Controls.Add("Forms.TextBox.1", "numTb_1", True) With txtBox .Width = 30 .left = Me.LbTitle3.left .top = btnTop btnTop = .top + .Height + 5 End With Me.LbTotal = "总人数：" & total Me.LbRemainder = "剩余人数：" & total Me.CmdAdd.top = txtBox.top Me.FrmHeader.Height = txtBox.top + txtBox.Height + 15 Me.CmdConfirm.top = Me.FrmHeader.top + Me.FrmHeader.Height + 5 Me.CmdExit.top = Me.CmdConfirm.top Me.Height = Me.CmdConfirm.top + Me.CmdConfirm.Height + 35End Sub
代码解析：
（1）Line1~10，定义一些变量。实例化类模块TextBoxEventHandler为clsTxB。
（2）line13~23，把“数据”表数据装入数组arr，循环数组，计算非空记录的个数，也就是总人数total，一般就是数组的最大行标，但不排除工作表有空白行的情况.
（3）line24，btnTop，控件的Top值，根据LbTitle1标签控件计算得出下一行控件的Top。
（4）line25~32，添加“考场”标签控件。
（5）line33~44，添加“人数”文本框控件，这里调用类模块 clsTxB 中的 ReceiveTextbox 方法，并将 txtBox 控件作为参数传递给该方法。将clsTxB对象添加到textBoxes集合中。
（6）line45~51，添加“每排人数”文本框。
（7）line52~58，设置一些控件的属性（Caption、Top、Height等）。
2、在UserForm1里，CmdAdd增行按钮：
Private Sub CmdAdd_Click() For Each ctrl In Me.Controls If ctrl.Name Like "topTb_*" Then If ctrl.Text = 0 Or ctrl.Text = "" Then MsgBox "请先按排已有考场" Exit Sub End If End If Next If remainder > 0 Then Call AddCtrl Me.CmdAdd.top = txtBox.top Me.FrmHeader.Height = txtBox.top + txtBox.Height + 15 Me.CmdConfirm.top = Me.FrmHeader.top + Me.FrmHeader.Height + 5 Me.CmdExit.top = Me.CmdConfirm.top Me.Height = Me.CmdConfirm.top + Me.CmdConfirm.Height + 35 End IfEnd Sub
代码解析：
（1）Line1~9，检查“人数”文本框中，有没有为空、为0的，如果有则提示、退出，不执行增行的操作。
（2）line10~17，如果剩余人数大于0，则调用AddCtrl过程增加一行，同时调整控件位置、窗体大小等。
3、在UserForm1里，AddCtrl添加控件过程：
Private Sub AddCtrl() Dim clsTxB As New TextBoxEventHandler endNum = 0 With UserForm1 For Each ctrl In .Controls If ctrl.Name Like "topTb_*" Then currEndNum = CInt(Mid(ctrl.Name, 7)) If endNum < currEndNum Then endNum = currEndNum End If End If Next btnTop = .Controls("topTb_" & endNum).top + .Controls("topTb_" & endNum).Height + 10 endNum = endNum + 1 Set lbctrl = .FrmHeader.Controls.Add("Forms.Label.1", "topLb_" & endNum, True) With lbctrl .Caption = "第" & Mid(.Name, InStr(.Name, "_") + 1) & "考场" .TextAlign = 2 .Width = 40 .left = Me.LbTitle1.left .top = btnTop End With Set txtBox = .FrmHeader.Controls.Add("Forms.TextBox.1", "topTb_" & endNum, True) With txtBox .Width = 30 .left = Me.LbTitle2.left .top = btnTop End With clsTxB.ReceiveTextbox txtBox If textBoxes Is Nothing Then '将 TextBoxEventHandler 对象添加到集合中 Set textBoxes = New Collection End If textBoxes.Add clsTxB Set clsTxB = Nothing Set txtBox = .FrmHeader.Controls.Add("Forms.TextBox.1", "numTb_" & endNum, True) With txtBox .Width = 30 .left = Me.LbTitle3.left .top = btnTop btnTop = .top + .Height + 5 End With End With
代码解析：
（1）Line5~12，通过循环所有控件，找到Name中结尾数据最大值endNum。
（2）line13~14，调整btnTop的值，把endNum最大的结尾数字加上1。
（3）line15~41，增加一个考场，跟窗体初始化添加控件类似。
4、在UserForm1里，CmdConfirm“确定”按钮、“退出”点击过程：
Private Sub CmdConfirm_Click() Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim rng As Range Dim lastRow As Integer, lastCol As Integer Dim arrArng(), arr(), iRow As Integer, Lines As Integer, iCol As Integer Set wsSource = Sheets("数据") Set wsTarget = Sheets("结果") With wsSource lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count arr = .Range(.Cells(2, 1), .Cells(lastRow, lastCol)).Value End With For Each ctrl In Me.Controls If ctrl.Name Like "topTb_*" Then endNum = CInt(Mid(ctrl.Name, 7)) If endNum > currEndNum Then currEndNum = endNum End If End If Next ReDim arrArng(1 To currEndNum, 1 To 3) i = 0 For Each ctrl In Me.Controls If ctrl.Name Like "topTb_*" Then i = i + 1 arrArng(i, 1) = i arrArng(i, 2) = Val(ctrl.Text) arrArng(i, 3) = Val(Me.Controls("numTb_" & i).Text) End If Next With wsTarget .Activate .Cells.Clear .Cells(1, 1) = "讲台" .Rows("1:1").HorizontalAlignment = xlGeneral For i = 1 To UBound(arrArng) If arrArng(i, 1) <> "" Then If arrArng(i, 2) = 0 Or arrArng(i, 3) = 0 Then MsgBox "安排人数不能为0！" Exit Sub End If iRow = .UsedRange.Rows.Count + 1 If iCol < arrArng(i, 3) Then iCol = arrArng(i, 3) End If iRow = iRow + 1 .Cells(iRow, 1) = "第" & arrArng(i, 1) & "考场" Lines = Application.WorksheetFunction.RoundUp(arrArng(i, 2) / arrArng(i, 3), 0) n = 0 For j = 1 To Lines For k = 1 To arrArng(i, 3) m = m + 1 n = n + 1 If m > UBound(arr) Then GoTo Exitline End If .Cells(iRow + j, k) = j & k & "." & arr(m, 3) If n = arrArng(i, 2) Then GoTo NextRoom End If Next Next End IfNextRoom: NextExitline: Set rng = .Range(.Cells(1, 1), .Cells(1, iCol)) rng.Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .Font.Size = 12 .RowHeight = 20 End With End With MsgBox "共" & UBound(arr) & "人，安排完成 " & m & "人!" Unload MeEnd SubPrivate Sub CmdExit_Click() Unload MeEnd Sub
代码解析：
（1）基本照搬昨天案例中的代码，去掉“安排”表有关代码。
（2）line14~22，循环窗体中的控件，找到Name最大的结尾数字，并据以重定义数组arrArng的大小。
（3）line23~31，循环窗体中的控件，把考场序号、人数、每排人数写入数组arrArng。
（4）其余跟昨天基本相同。根据参数表arrArng，把安排结果写入目标工作表“结果”表。
5、在类模块TextBoxEventHandler里：
Public WithEvents txtBox As MSForms.TextBoxPrivate previousValue As StringPublic Sub ReceiveTextbox(ByVal reTextbox As MSForms.TextBox) Set txtBox = reTextboxEnd SubPrivate Sub txtBox_Change() Dim ctrl As Control Dim currTotal As Integer On Error Resume Next Dim endNum As Integer, currEndNum As Integer currEndNum = Val(Mid(txtBox.Name, 7)) txtBox.Text = Val(txtBox.Text) With UserForm1 For Each ctrl In .Controls If ctrl.Name Like "topTb_*" Then currTotal = currTotal + Val(ctrl.Text) End If Next remainder = total - currTotal If remainder < 0 Then MsgBox "超出！" txtBox.Text = previousValue Exit Sub ElseIf remainder = 0 Then For Each ctrl In .Controls endNum = Val(Mid(ctrl.Name, 7)) If endNum > currEndNum Then .Controls.Remove ctrl.Name End If Next Set txtBox = .Controls("topTb_" & currEndNum) .CmdAdd.top = txtBox.top .FrmHeader.Height = txtBox.top + txtBox.Height + 15 .CmdConfirm.top = .FrmHeader.top + .FrmHeader.Height + 5 .CmdExit.top = .CmdConfirm.top .Height = .CmdConfirm.top + .CmdConfirm.Height + 35 End If .LbRemainder = "剩余：" & remainder End WithEnd SubPrivate Sub txtbox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ' 在按下任意键之前，存储当前值 previousValue = txtBox.ValueEnd Sub
代码解析：
（1）line12，使得文本框只能输入正整数。
（2）line13~39，TextBox的Change事件。
（A）line14~19，首先计算已安排的总人数、剩余人数。
（B）line20~37，根据剩余人数进行相应处理。如果超出总人数，则把TextBox恢复成原来的值，退出过程。如果剩余数等于0，则把当前文本框下面的控件删除，调整控件位置，窗体大小。如果剩余数大于0，则什么也不做。
（3）line38，更新标签LbRemainder的值。
6、在工作表“安排2”中命令按钮
Private Sub CmdArrange2_Click() Application.ScreenUpdating = False UserForm1.Show Application.ScreenUpdating = TrueEnd Sub
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！