将列表框项目导出到 Excel 电子表格中的命名范围

Question

我在 Excel VBA 的用户表单上有一个名为 listBox1 的列表框，在表单上还有一个名为 submit 的按钮。列表框是从表格 2 的单元格 A2 开始的动态范围填充的。我想将此列表框的内容导出到表格 1 上名为 dataCells 的命名范围。我当前使用的代码很接近，但不知何故将列表框数据导出到工作表 1 的单元格 A1，而不是从命名范围“数据单元格”的第一个单元格开始。我究竟做错了什么？

//Code to populate listBox 1

Private Sub Userform1_initialize()
    Dim dataItems as Range
    Dim item as Range

    worksheets("sheet2").Activate
    Set dataItems = Range("A2" , Range("A2").end(xlDown))
    for each item in dataItems
        listbox1.addItem(item)
    Next item
End sub

//Code to export the listbox contents to named range in sheet 1

Private Sub Submit_Click()

    Dim dataCells as Range
    Dim dataCount as Integer
    Dim i as integer

    worksheets("sheet1").Activate
    dataCount = listBox1.ListCount - 1
    set dataCells = Range("B2" , Range("B2").offset(0, dataCount))

    for i = 0 to listBox1.ListCount - 1
        dataCells(0, i) = listBox1.list(i , 0) // exports to A1 of sheet 1??
    next i
End sub

Answer 1

在我的代码示例中，我想展示一种无需使用 additem 即可快速填充列表框的方法，

也用于导出到 sheet1，我使用了 VBA 数组，但 listbox1.list 也可以工作（我添加了 cmets）

这行得通：

Option Explicit

Private Sub UserForm_Activate()
Dim i&
Dim dataItems As Range
With Me
    With .ListBox1
        .Clear 'not needed in userform_initialize, but i did it in a _activate sub

        With Worksheets("sheet2")
            Set dataItems = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) 'i modified this because if your code hits a blank, it will think its the last line...
        End With

        .List = dataItems.Value

        Dim Data()
        ReDim Data(1 To .ListCount, 1 To 1)
        Data = .List

        'this section goes to Submit_Click()
        With Worksheets("sheet1")
            Set dataItems = .Range("B2", .Range("B2").Offset(Me.ListBox1.ListCount - 1, 0))
        End With
        With dataItems
            .Value = Data '.value2=me.listbox1.list  , works too
        End With
    End With 'listbox1
End With 'me
End Sub

Answer 2

试试这个，让我知道它是否适合你。请注意，如果项目不是字符串，您可以将 dataArray 更改为 Variant（如果您使用的是 VB）。基本上，我将列表框项放入一个数组中，然后将其填充到一个 Range 中：

Private Sub Submit_Click()

    worksheets("sheet1").Activate

    Dim i as integer
    dim dataArray(listBox1.ListCount-1) as String
    for i = 0 to listBox1.ListCount - 1
        dataArray(i) = listBox1.list(i , 0) 
    next i

    Range("B2").Resize(listBox1.ListCount -1,1) = dataArray

End sub