vba - 如何将数组返回到Excel VBA范围

Question

我一直在尝试从工作表中获取数据并将其放入数组中，然后将数组粘贴到其他工作表中。但是，在循环之后我的数组返回空。我需要从 For 循环返回一些东西吗？我搜索了没有找到任何想法。

Sub generate()
    Dim article_arr() As Variant
    Dim artCount As Integer
    Dim filter As Integer
    Dim RIL_itemCount As Integer

    'Set PA number
    filter = Sheet7.Range("B1").Value
    RIL_itemCount = Sheet5.Cells(Sheet5.Rows.count, "A").End(xlUp).Row

    'Count number article of PA selected
    artCount = Application.WorksheetFunction.CountIf(Sheet5.Range("R:R"), filter)

    'redim array
    ReDim article_arr(0 To artCount)
    Dim j As Integer
    j = 0

    'populate array with article number from Retail Item List
    For i = 0 To RIL_itemCount
        If (Sheet5.Cells(i + 2, 18).Value = filter) Then
            article_arr(j) = Sheet5.Cells(i + 2, 1).Value          
            Debug.Print (article_arr(j))
        End If
    Next

    'Paste Article number to range
    Sheet7.Range("A8:A" & artCount) = articleArr()


End Sub

正如 David G 所提到的。我忘记增加 J。粘贴数组时我还使用了错误的变量(新手错误)。它现在返回结果，但仅返回在粘贴范围内重复的数组的第一个值。我需要 for 循环将数组粘贴到范围吗？

显然数组将在Excel中水平粘贴，这会导致在将数组粘贴到范围时重复第一个值。添加 WorksheetFunction.Transpose(array) 发挥神奇作用

这是更新后的代码:

Sub generate()
    Dim article_arr() As Variant
    Dim artCount As Integer
    Dim filter As Integer
    Dim RIL_itemCount As Integer

    'Set PA number
    filter = Sheet7.Range("B1").Value
    RIL_itemCount = Sheet5.Cells(Sheet5.Rows.count, "A").End(xlUp).Row

    'Count number article of PA selected
    artCount = Application.WorksheetFunction.CountIf(Sheet5.Range("R:R"), filter)

    'redim array
    ReDim article_arr(0 To artCount)
    Dim j As Integer
    j = 0

    'populate array with article number from Retail Item List
    For i = 0 To RIL_itemCount
        If (Sheet5.Cells(i + 2, 18).Value = filter) Then
            article_arr(j) = Sheet5.Cells(i + 2, 1).Value
            j = j + 1
        End If
    Next

    'Paste Article number to range
    k = 8
    Sheet7.Range("A" & k & ":A" & UBound(article_arr) + 7) = WorksheetFunction.Transpose(article_arr)
    Debug.Print (article_arr(395))


End Sub

Answer 1

数组⇒范围最有效/动态的方法:

有一种更有效的方法可以将一维或二维值数组中的数据放置到工作表上，只要它是单个区域(即，“无跳过的单元格” )。

A worksheet is basically a two-dimensional array.
However, interacting with the worksheet repeatedly (such as looping through every element in the array to populate one cell at a time) is an extremely expensive operation.

<小时/>

调用此过程，仅向其传递一个数组和一个表示所需输出数据“左上角”的单单元格区域。输入数组可以是二维的，或者:来自某个范围的一维数组。”

Sub Array2Range(arr, destTL As Range)
    'dumps [arr] (1D/2D) onto a sheet where [destTL] is the top-left output cell.
    destTL.Resize(UBound(arr, 1) - LBound(arr, 1) + 1, _
        UBound(arr, 2) - LBound(arr, 2) + 1) = arr
End Sub

<小时/>

示例:

Sub test_A2R()
    Dim myArr 'dimension a variant (variants can also hold implicit arrays!)

    'create a static two-dimensional (6x3) array
    myArr = [{1, 2, 3, "A", "D", "G"; 4, 5, 6, "B","E","H"; 7, 8, 9,"C","F","I"}]

    'dump the array onto the activesheet starting starting at cell [A1]
    Array2Range myArr, Range("A1")

End Sub

Sub test_R2A2R()
    Dim a 'dimension a variant
    a = Range("A1:E3")

    'do "something" to the data here (otherwise we should just use `Range.Copy`)
    'let's transpose the data, for no particular reason
    a = Application.WorksheetFunction.Transpose(a)

    Array2Range a, Range("C6") 'dump the array starting at Top-Left of [C5]
End Sub

示例输出:

运行两个示例子程序，您将得到:

_{(灵感来自 Chip Pearson )}