如何将数组返回到范围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.我在粘贴数组时也使用了错误的变量（新手错误）。它现在返回结果但它只返回在粘贴范围内重复的数组的第一个值。我是否需要循环将Array粘贴到范围？

显然，数组将在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

您的数组应该根据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乘3的数组，您可以编写

Range("A1:B3") = array

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

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

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

Answer 2

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