将多个组合框合并到一列中

Question

只是想问是否可以有多个组合框，将值同时放入一列中？数据项下的所有组合框将位于工作表的 B 列中，计划下的所有组合框将位于 C 列中。顶部文本框的值将位于 A 列中。请参阅以下代码和插图供参考。

Private Sub CommandButton1_Click()

    Dim sh As Worksheet, msg As String, arr, c As Range, id
    
    'check for any empty required fields
    If Len(TextBox1.Value) = 0 Then msg = msg & vbLf & " - ID"

    If Len(msg) > 0 Then 'anything missing?
        MsgBox "The following fields are required:" & msg, _
                vbOKOnly + vbCritical, "Missing Information"
    Else
        'OK to write to sheet
        Set sh = ThisWorkbook.Sheets("Employee File")
        Set c = sh.Cells(Rows.Count, "A").End(xlUp).Offset(1) '##start adding here
        arr = Split(TextBox1.Value, ",") '##split on comma to get an array
        For Each id In arr               '##loop over the array
            c.Resize(1, 3).Value = Array(Trim(id), ComboBox1.Value, ComboBox2.Value)
            Set c = c.Offset(1)          '##next output row
        Next id

        MsgBox "Information Added", vbOKOnly + vbInformation, "Notification"
        Unload Me
    End If
End Sub

Answer 1

未经测试，但您可以循环组合框，假设它们都是连续命名的（即

ComboBox1

到

ComboBox16

）：

Private Sub CommandButton1_Click()

    Dim sh As Worksheet, msg As String, arr, c As Range, id, dataItem, schedule, i As Long
    
    'check for any empty required fields
    If Len(TextBox1.Value) = 0 Then msg = msg & vbLf & " - ID"

    If Len(msg) > 0 Then 'anything missing?
        MsgBox "The following fields are required:" & msg, _
                vbOKOnly + vbCritical, "Missing Information"
    Else
        'OK to write to sheet
        Set sh = ThisWorkbook.Sheets("Employee File")
        Set c = sh.Cells(Rows.Count, "A").End(xlUp).Offset(1) 'start adding here
        arr = Split(TextBox1.Value, ",")                      'split on comma to get an array
        
        For i = 1 To 16 Step 2                           '## loop over comboboxes
            dataItem = Me.Controls("ComboBox" & i).Value '## read combo values...
            schedule = Me.Controls("ComboBox" & (i + 1)).Value
            If Len(dataItem) > 0 Then             '## any value selected?
                For Each id In arr                'loop over the id array
                    c.Resize(1, 3).Value = Array(Trim(id), dataItem, schedule)
                    Set c = c.Offset(1)           'next output row
                Next id
            End If
        Next i
        
        MsgBox "Information Added", vbOKOnly + vbInformation, "Notification"
        Unload Me
    End If
End Sub