Excel 如何编写宏将多个组合框中的数据复制到工作表

我有一个带有多个组合框的用户表单，我想用它在工作表上记录数据。如何在循环中编写代码，这样就不必为所有60种情况编写代码？下面是我所拥有的一个例子：

编辑以添加整个子对象：

Private Sub FltData_Click()

    'Check for empty date boxes
    Dim IsEmptyDateBox As Boolean
    IsEmptyDateBox = IsBlankDateBox()

    If IsEmptyDateBox = True Then
        MsgBox "Empty Date Box Detected"
    End If

    'Check for complete training boxes
    Dim IsEmptyTextBox As Boolean
    IsEmptyTextBox = IsBlankTextBox()

    If IsEmptyTextBox = True Then
        MsgBox "Incomplete Training Info Detected"
    End If

    'Input date function
    Dim DateSelect As String
    Dim Month As String
    Dim Day As String
    Dim Year As String

    If DateMonth.Value = "January" Then
        Month = "01"
        Elseif DateMonth.Value = "February" Then
        Month = "02"
        Elseif DateMonth.Value = "March" Then
        Month = "03"
        Elseif DateMonth.Value = "April" Then
        Month = "04"
        Elseif DateMonth.Value = "May" Then
        Month = "05"
        Elseif DateMonth.Value = "June" Then
        Month = "06"
        Elseif DateMonth.Value = "July" Then
        Month = "07"
        Elseif DateMonth.Value = "August" Then
        Month = "08"
        Elseif DateMonth.Value = "September" Then
        Month = "09"
        Elseif DateMonth.Value = "October" Then
        Month = "10"
        Elseif DateMonth.Value = "November" Then
        Month = "11"
        Elseif DateMonth.Value = "December" Then
        Month = "12"
    End If

    Day = DateDay.Value
    Year = DateYear.Value
    DateSelect = Month + "/" + Day + "/" + Year

    'Is data already inputed/eliminate duplicates
    Call DuplicateCheck

    'Select FltData worksheet
    Worksheets("FltData").Select

    'Select blank row after last entry
    LastRow = Worksheets("FltData").UsedRange.SpecialCells(xlCellTypeLastRow).Row
    Cells(LastRow + 1,1).Select

    'Input UserForm info to Worksheet
    ActiveCell.Value = DateSelect
    ActiveCell.Offset(, 1).Value = Time1.Value
    ActiveCell.Offset(, 2).Value = Crew1.Value
    ActiveCell.Offset(, 3).Value = TR1.Value
    ActiveCell.Offset(, 4).Value = Status1.Value

    If Time2.Value <> "" Then
        ActiveCell.Offset(1, 0).Value = DateSelect
        ActiveCell.Offset(1, 1).Value = Time2.Value
        ActiveCell.Offset(1, 2).Value = Crew2.Value
        ActiveCell.Offset(1, 3).Value = TR2.Value
        ActiveCell.Offset(1, 4).Value = Status2.Value
    End If

    If Time3.Value <> "" Then
        ActiveCell.Offset(2, 0).Value = DateSelect
        ActiveCell.Offset(2, 1).Value = Time3.Value
        ActiveCell.Offset(2, 2).Value = Crew3.Value
        ActiveCell.Offset(2, 3).Value = TR3.Value
        ActiveCell.Offset(2, 4).Value = Status3.Value
    End If

    If Time4.Value <> "" Then
        ActiveCell.Offset(3, 0).Value = DateSelect
        ActiveCell.Offset(3, 1).Value = Time4.Value
        ActiveCell.Offset(3, 2).Value = Crew4.Value
        ActiveCell.Offset(3, 3).Value = TR4.Value
        ActiveCell.Offset(3, 4).Value = Status4.Value
    End If

    Call SortByDateTime

End Sub

Private Sub FltData_Click（）
'检查空的日期框
Dim IsEmptyDateBox为布尔值
IsEmptyDateBox=IsBlankDateBox（）
如果IsEmptyDateBox=True，则
MsgBox“检测到空日期框”
如果结束
'检查完整的培训框
Dim IsEmptyTextBox为布尔值
ismptytextbox=IsBlankTextBox（）
如果IsEmptyTextBox=True，则
MsgBox“检测到不完整的培训信息”
如果结束
'输入日期函数
Dim DATE选择为字符串
暗月如弦
朦胧的日子
朦胧的一年
如果DateMonth.Value=“一月”，则
月份=“01”
Elseif DateMonth.Value=“二月”则
月份=“02”
Elseif DateMonth.Value=“March”则
月份=“03”
Elseif DateMonth.Value=“April”则
月份=“04”
Elseif DateMonth.Value=“May”则
月份=“05”
Elseif DateMonth.Value=“June”则
月份=“06”
Elseif DateMonth.Value=“July”则
月份=“07”
Elseif DateMonth.Value=“八月”则
月份=“08”
Elseif DateMonth.Value=“九月”则
月份=“09”
Elseif DateMonth.Value=“十月”则
月份=“10”
Elseif DateMonth.Value=“11月”则
月份=“11”
Elseif DateMonth.Value=“十二月”则
月份=“12”
如果结束
Day=DateDay.Value
年=日期年。值
日期选择=月+“/”+日+“/”+年
'数据是否已输入/消除重复
呼叫重复检查
'选择FltData工作表
工作表（“FltData”）。选择
'选择最后一项后的空行
LastRow=工作表（“FltData”）.UsedRange.SpecialCells（xlCellTypeLastRow）.Row
单元格（LastRow+1,1）。选择
'将用户表单信息输入到工作表
ActiveCell.Value=DateSelect
ActiveCell.Offset（，1）.Value=Time1.Value
ActiveCell.Offset（，2）.Value=Crew1.Value
ActiveCell.Offset（，3）.Value=TR1.Value
ActiveCell.Offset（，4）.Value=Status1.Value
如果Time2.Value为“”，则
ActiveCell.Offset（1，0）.Value=DateSelect
ActiveCell.Offset（1，1）.Value=Time2.Value
ActiveCell.Offset（1，2）.Value=Crew2.Value
ActiveCell.Offset（1,3）.Value=TR2.Value
ActiveCell.Offset（1，4）.Value=Status2.Value
如果结束
如果Time3.Value为“”，则
ActiveCell.Offset（2，0）.Value=DateSelect
ActiveCell.Offset（2，1）.Value=Time3.Value
ActiveCell.Offset（2，2）.Value=Crew3.Value
ActiveCell.Offset（2,3）.Value=TR3.Value
ActiveCell.Offset（2，4）.Value=Status3.Value
如果结束
如果Time4.Value为“”，则
ActiveCell.Offset（3，0）.Value=DateSelect
ActiveCell.Offset（3，1）.Value=Time4.Value
ActiveCell.Offset（3,2）.Value=Crew4.Value
ActiveCell.Offset（3,3）.Value=TR4.Value
ActiveCell.Offset（3,4）.Value=Status4.Value
如果结束
呼叫SortByDateTime
端接头

我想我找到了一种方法，通过使用我来完成。控件：

Dim x As Integer
Dim y As Integer
Dim z As Integer

x = 1
y = 2

For y = 2 To 48
    If Me.Controls("Time" & y).Value <> "" Then
        ActiveCell.Offset(x, 0).Value = DateSelect
        ActiveCell.Offset(x, 1).Value = Me.Controls("Time" & y).Value
        ActiveCell.Offset(x, 2).Value = Me.Controls("Crew" & y).Value
        ActiveCell.Offset(x, 3).Value = Me.Controls("TR" & y).Value
        ActiveCell.Offset(x, 4).Value = Me.Controls("Status" & y).Value
    End If
    x = x + 1
Next y

Dim x作为整数
Dim y作为整数
将z调整为整数
x=1
y=2
对于y=2到48
如果Me.Controls（“Time”&y）.Value为“”，则
ActiveCell.Offset（x，0）.Value=DateSelect
ActiveCell.Offset（x，1）.Value=Me.Controls（“时间”&y）.Value
ActiveCell.Offset（x，2）.Value=Me.Controls（“Crew”&y）.Value
ActiveCell.Offset（x，3）.Value=Me.Controls（“TR”&y）.Value
ActiveCell.Offset（x，4）.Value=Me.Controls（“Status”&y）.Value
如果结束
x=x+1
下一个y

您是否有固定数量的控件/组合框？组合框在代码中的位置？对于每个分组，组合框名称为Time1、Crew1、TR1、Status1，我有60组组合框。因此，下一个分组是2,3,4…将对象设置为类似

set ctl=me.controls（“Time”&l）

的值，然后使用类似

ctl.value

的值，其中l是循环中的计数器。请发布整个代码，以便我可以使用您想要的逻辑为您重新编写它。