首页 文章

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

提问于
浏览
0

我在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

2 回答

  • 0

    在我的代码示例中,我想显示一种快速的方法来填充列表框而不使用additem,

    也导出到sheet1,我使用了VBA阵列,但listbox1.list也有效(我添加了评论)

    这工作:

    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
    
  • 0

    尝试一下,让我知道它是否适合您 . 请注意,如果项目不是字符串,则可以将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
    

相关问题