Экспорт элементов списка в именованный диапазон в электронной таблице Excel

Question

У меня есть список с именем listBox1 в форме пользователя в Excel VBA и кнопка с именем submit также в форме. Список заполняется из динамического диапазона, начиная с ячейки A2 листа 2. Я хочу экспортировать содержимое этого списка в именованный диапазон с именем dataCells на листе 1. Код, который я использую в настоящее время, близок, но каким-то образом экспортирует данные из списка ячейку A1 листа 1 вместо запуска в первой ячейке «ячеек данных» именованного диапазона. Что я делаю не так?

//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

в моем примере кода я хочу показать быстрый способ для заполнения в ListBox без использования 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 

Answer 2

Дайте мне попробовать и дайте мне знать, будет ли это работать на вас. Обратите внимание: если элементы не являются строками, вы можете изменить dataArray на Variant (если вы используете VB). В принципе, я поместил элементы ListBox в массив, а затем засунул в диапазон:

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