如何将数组返回到范围excel vba

Question

我一直在尝试从工作表中获取数据并将其放入数组中，然后将数组粘贴到其他工作表中。但是，在循环之后，我的数组返回 Empty。我需要从 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

Array⇒Range的最有效/动态方法：

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

工作表基本上是一个二维数组。
但是，重复与工作表交互（例如循环遍历数组中的每个元素以一次填充一个单元格）是一种极端expensive操作。

---

调用此过程，只传递一个数组和一个单单元格范围，表示输出数据的所需“左上角”。输入数组可以是二维的，或者：范围内的一维。”

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）}

Answer 2

您的数组应该根据j 整数填充，但您不增加它。

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
        Debug.Print (article_arr(j))
    End If
Next

此外，当将数组粘贴到单个单元格时，它会完全按照您的描述进行操作；将第一个数组值粘贴到任何地方以获取数组的大小。要让它放置正确的值，您需要将其发送到与数组大小相同的范围内。例如，对于大小为 2 x 3 的数组，您可以编写

Range("A1:B3") = array

在您的情况下，您希望大小是动态的，就像数组的大小一样。

k = 8
Range("A" & k & ":A" & k + Ubound(article_arr, 1)) = article_arr

应该做的伎俩。正如您所看到的，它将粘贴从 A8 开始的范围，并且长度与数组中值的数量相同。

Answer 3

根据我的上述评论（处理一维数组），建议对上述@ashleeDawg 的答案进行适度的更改：

Sub sub_Array2Range(arrArray, rngSingleAreaTopLeftCell As Range)
    'dumps [arrArray] (1D/2D) onto a sheet
    ' where [rngSingleAreaTopLeftCell] is the top-left output cell.
On Error GoTo OneDimension
rngSingleAreaTopLeftCell.Resize(UBound(arrArray, 1) - LBound(arrArray, 1) + 1, _
        UBound(arrArray, 2) - LBound(arrArray, 2) + 1) = arrArray
Exit Sub

OneDimension:
    rngSingleAreaTopLeftCell _
       .Resize(UBound(arrArray, 1) - LBound(arrArray, 1) + 1) _
            = Application.Transpose(arrArray)
End Sub

看到这个问题，对于转置解决的问题（没有它，语句用第一个数组元素填充范围内的每个单元格）：

Writing an array to a range. Only getting first value of array