用数组填充列表框并将下一个 2 数组添加到

Question

我在for 循环中打开许多工作簿并将数据加载到动态array。 现在我需要从这些arrays 中获取值到列表框中，但不知道如何...

Dim rng as Variant
Set rng = wsDat.Range(Cells(2, 1), Cells(lastRow, 1).Offset(0, 10)) 'for more ws

myArray1 = rng.Value 'result of ws1 data
myArray2 = rng.Value 'result od ws2 data
.
.
.

Me.myListbox.List = myArray1
Me.myListbox.List ??? add myArray2

Answer 1

假设您需要在列表框中加载这些数组的所有内容，您不能使用list 属性来以这种方式添加项目。下一个.list = array 会删除之前的列表项。您可以使用它一次，然后通过迭代添加项目，或者更优雅地加入数组并在最后使用list 加载加入的数组。要测试最后一种方式，请尝试下一个代码：

 Sub JoinArraysLoadList()
    Dim ws As Worksheet, lastRow As Long, myArray, myArrTot
    
    For Each ws In ActiveWorkbook.Sheets
            lastRow = ws.cells(ws.rows.count, 1).End(xlUp).row
            myArray = ws.Range(ws.cells(2, 1), ws.cells(lastRow, 1).Offset(0, 10)).Value
            If Not IsArray(myArrTot) Then 'if myArrTot did not receive any range value:
                myArrTot = myArray
            Else                                    'join myArrTot with the newly extracted array:
                'the arrays need to be transposed, in order to add elements (allowed only on the second dimension)
                myArrTot = JoinArrays(Application.Transpose(myArrTot), Application.Transpose(myArray))
            End If
    Next
    Me.myListbox.List = myArrTot
 End Sub

 Function JoinArrays(arrT, arr) As Variant
    Dim i As Long, j As Long, nrRows As Long
    
    nrRows = UBound(arrT, 2) 'the existing number of rows (now, columns...)
    ReDim Preserve arrT(1 To UBound(arrT), 1 To nrRows + UBound(arr, 2))
    For i = 1 To UBound(arr)
        nrRows = nrRows + 1 'increment the next row to be loaded
        For j = 1 To UBound(arr, 2)
            arrT(j, nrRows) = arr(i, j)
        Next j
    Next i
    JoinArrays = Application.Transpose(arrT)
 End Function

已编辑：

下一个解决方案应该是更快/更高效的变体：

Sub JoinArraysLoadListJgArr()
    Dim wb As Workbook, ws As Worksheet, lastRow As Long
    Dim cnt As Long, noEl As Long, myArray, myArrTot, jgArr
    
    Set wb = ActiveWorkbook          'use here the necessary workbook
    ReDim jgArr(wb.Sheets.count - 1) 'redim the jagged array at the maximum necessary dimensioned (0 based array)
    For Each ws In wb.Sheets
            lastRow = ws.cells(ws.rows.count, 1).End(xlUp).row
            myArray = ws.Range(ws.cells(2, 1), ws.cells(lastRow, 1).Offset(0, 10)).Value
            noEl = noEl + UBound(myArray)       'counting the number of each array rows
            jgArr(cnt) = myArray: cnt = cnt + 1 'loading each sheet array in the jagged one
    Next
    If cnt < wb.Sheets.count Then
        ReDim Preserve jgArr(cnt - 1) 'preserve only the existing elements (if a sheet or more have been skipped)
    End If
    myArrTot = JoinJgArr(jgArr, noEl)
    Me.myListbox.List = myArrTot
 End Sub
 
 Function JoinJgArr(jgA, N As Long) As Variant
    Dim k As Long, i As Long, j As Long, iRow As Long, arrFin
    
    ReDim arrFin(1 To N, 1 To UBound(jgA(0), 2)) 'redim the array to take the jagged array elements
    
    For k = 0 To UBound(jgA)                  'iterate between the jagged array elements
        For i = 1 To UBound(jgA(k))           'iterate between each jagged array element rows
            iRow = iRow + 1                   'counting the rows or the final array to be filled!!!
            For j = 1 To UBound(jgA(k), 2)    'iterate between each jagged array element columns
                arrFin(iRow, j) = jgA(k)(i, j)'put values in the final array
            Next j
        Next i
    Next k
    
    JoinJgArr = arrFin
 End Function