如何实现多组ComboBox值分别写入Excel指定列并同步保存？

当然可以实现这个需求，下面是适配多组ComboBox场景的修改后代码，核心思路是先对ComboBox按「数据项」「日程」分类，再批量遍历写入对应列：

Private Sub CommandButton1_Click()
    Dim sh As Worksheet, msg As String, arrIDs, c As Range, id As Variant
    Dim dataCbos As Variant, scheduleCbos As Variant
    Dim i As Integer
    
    ' 校验必填字段：顶部TextBox不能为空
    If Len(TextBox1.Value) = 0 Then
        msg = msg & vbLf & " - 顶部ID输入框"
    End If
    
    ' 定义「数据项」和「日程」分类的ComboBox数组
    ' 请根据实际控件名称修改这里的列表，保证两组数量一致
    dataCbos = Array(ComboBox1, ComboBox3, ComboBox5) ' 数据项分类的所有ComboBox
    scheduleCbos = Array(ComboBox2, ComboBox4, ComboBox6) ' 日程分类的所有ComboBox
    
    ' 校验两组ComboBox数量是否匹配
    If UBound(dataCbos) <> UBound(scheduleCbos) Then
        msg = msg & vbLf & " - 数据项和日程类别的ComboBox数量不匹配"
    End If
    
    ' 有必填项缺失或配置错误时提示
    If Len(msg) > 0 Then
        MsgBox "以下信息存在问题：" & msg, vbOKOnly + vbCritical, "错误提示"
        Exit Sub
    End If
    
    ' 写入工作表逻辑
    Set sh = ThisWorkbook.Sheets("Employee File")
    Set c = sh.Cells(Rows.Count, "A").End(xlUp).Offset(1) ' 获取下一个空行
    
    arrIDs = Split(TextBox1.Value, ",") ' 拆分TextBox中的多个ID
    
    ' 遍历每个ID
    For Each id In arrIDs
        id = Trim(id) ' 去除ID前后空格
        ' 遍历每组ComboBox，逐行写入
        For i = LBound(dataCbos) To UBound(dataCbos)
            ' A列：ID；B列：对应数据项ComboBox值；C列：对应日程ComboBox值
            c.Resize(1, 3).Value = Array(id, dataCbos(i).Value, scheduleCbos(i).Value)
            Set c = c.Offset(1) ' 下移到下一行
        Next i
    Next id
    
    MsgBox "信息已成功添加", vbOKOnly + vbInformation, "完成提示"
    Unload Me
End Sub

关键说明： #

• 分类管理ComboBox：通过dataCbos和scheduleCbos两个数组，把不同分类的ComboBox归类，后续新增/删除控件时只需修改数组列表即可，无需改动核心写入逻辑。
• 多ID批量处理：保留原代码中拆分TextBox多ID的逻辑，每个ID都会对应生成与ComboBox组数相同的行。
• 校验增强：新增了两组ComboBox数量匹配的校验，避免出现数据错位。
• 灵活扩展：如果后续需要新增「数据项」或「日程」的ComboBox，只需在对应的数组中添加控件名称即可，比如新增ComboBox7到数据项数组，ComboBox8到日程数组。

内容的提问来源于stack exchange，提问作者Jc Vivo