Multi-Select ListBox内容到Range

Question

我使用 VBA 创建了一个包含各种文本框、组合框和列表框的用户窗体。我目前将其设置为一旦您点击提交按钮 (Commandbutton1)，各种框的内容将填充我 sheet.

上的一个 selected 单元格

Private Sub CommandButton1_Click()

    Sheets("Sheet2").Range("D4") = TextBox1.Text
    Sheet2.Cells(5, 4) = ComboBox2.Text
    Sheet2.Cells(6, 4) = ComboBox1.Text
    Sheet2.Cells(7, 4) = TextBox2.Text
    Sheet2.Cells(8, 4) = TextBox4.Text

    UserForm1.Hide

End Sub

我还希望我的 multiselect 列表框的内容对单元格 (9, 4) - (15, 4) 执行相同的操作。我怎样才能做到这一点？此多 select 列表框中的选项包括 Insight、Barracuda、Siena、Visio、Project。

Answer 1

您可以迭代 ListBox 的选定项目并将它们添加到数组中。收集完所有选定的项目后，转移到Range。例如：

Private Sub CommandButton1_Click()

    ' your code
    Sheets("Sheet2").Range("C8") = TextBox1.Text
    Sheets("sheet2").Range("C12") = ComboBox2.Text
    Sheets("sheet2").Range("F12") = ComboBox1.Text
    Sheets("sheet2").Range("F8") = TextBox2.Text
    Sheets("sheet2").Range("F10") = TextBox4.Text
    Sheets("Sheet2").Range("C30") = TextBox7.Text
    Sheets("Sheet2").Range("F29:F36") = TextBox8.Text

    ' my code to update the sheet with the listbox selections
    Dim ws As Worksheet
    Dim rng As Range
    Dim lng1 As Long
    Dim lng2 As Long
    Dim str() As String

    Set ws = ThisWorkbook.Worksheets("Sheet2")
    Set rng = ws.Range("F22") ' (9, 4) - (15, 4)

    lng2 = 0 ' count of selected items
    For lng1 = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(lng1) Then
            lng2 = lng2 + 1 ' increment counter
            ReDim Preserve str(1 To lng2) ' resize array...
            str(lng2) = Me.ListBox1.List(lng1) ' and add selected item
        End If
    Next lng1

    ' transfer to range
    rng.Resize(lng2, 1).Value = Application.Transpose(str)

    ' close form
    'Unload Me
    UserForm1.Hide

End Sub

Multi-Select ListBox内容到Range

Multi-Select ListBox contents to Range

excel

vba

listbox

userform