arrays - 转置数组和自动填充

Question

我正在寻找一种更有效、更少硬编码的方式来转置数组，然后在相邻列中自动填充公式。这是我当前的代码，用于在工作表上的特定位置转置我的数组并自动填充列:

 If Len(Join(myArray)) > 0 Then
    ActiveWorkbook.Sheets("Delta Summary").Range("A3:A" & UBound(myArray) + 2) = WorksheetFunction.Transpose(myArray)
    ActiveWorkbook.Sheets("Delta Summary").Range("B3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFill Destination:=Range("B3:K17"), Type:=xlFillDefault
Else: End If

目标是转置从工作表“Delta Summary”上的单元格 A3 开始的数组。我的代码完成了这一点，但我想知道是否有更好的方法来做到这一点。作为引用，我遍历这个数组并根据不同的标准对其进行多次转置。我从单元格 A3、A20、A37、...和 ​​A224 开始转置数组。每个部分有 15 个单元格分配给数据。

至于自动填充，我想将 B:K 列中的公式自动填充到 A 列中该预定义范围的最后一个填充单元格(例如 A3:A17、A20:34 等)。 )。我不知道如何找到预定义范围的最后一个填充单元格，所以我有这个硬编码。

我还在学习，所以任何见解将不胜感激!

编辑:这是我用来填充数组的循环条件的一个示例:

ReDim myArray(0)
For i = 1 To LastCurrID
    If ActiveWorkbook.Sheets("Weekly Comparison").Range("N" & i) = "N" And ActiveWorkbook.Sheets("Weekly Comparison").Range("J" & i) = "Billing" Then
    myArray(UBound(myArray)) = ActiveWorkbook.Sheets("Weekly Comparison").Range("A" & i)
    ReDim Preserve myArray(UBound(myArray) + 1)
End If
Next i 

编辑#2:对于那些好奇的人，这里是完整的代码。我只是稍微改变了下面评论的内容。

    ReDim myArray(0)
For i = 1 To LastCurrID
    If wkb.Sheets("Weekly Comparison").Range("N" & i) = "N" And wkb.Sheets("Weekly Comparison").Range("J" & i) = "Billing" Then
        myArray(UBound(myArray)) = wkb.Sheets("Weekly Comparison").Range("A" & i)
        ReDim Preserve myArray(UBound(myArray) + 1)
    End If
Next i

For y = LBound(myArray) To UBound(myArray)
    If Len(Join(myArray)) > 0 Then
        With wks
            .Range("A" & x & ":A" & UBound(myArray) + x - 1) = WorksheetFunction.Transpose(myArray)
            Dim lRow As Long
            lRow = .Range("A" & x).End(xlDown).Row - x + 1
            .Range("B" & x).Resize(1, 10).AutoFill _
                Destination:=.Range("B" & x).Resize(lRow, 10), Type:=xlFillDefault
        End With
    End If
Next
x = x + 17

Answer 1

编辑(基于带有循环的 OP 更新问题)

从您构建数组的方式来看，该数组似乎正在加载每个范围要复制的数据范围的最后一行(在 15 行限制内)。

下面将再次循环遍历数组，并为每个循环(从 3 开始)设置 17 到 x 的因子，并将找到从 'Bx' 开始的指定范围内的最后一行，并使用 .Resize做AutoFill的方法:

'always best to qualify the workbook, worksheet objects with a variable
Dim wkb As Workbook, wks As Worksheet
Set wkb = Workbooks("myWKb")
Set wks = wkb.Sheets("Delta Summary")

Dim x As Long, y As Long
x = 3

For y = LBound(myArray) To UBound(myArray)

    If Len(Join(myArray)) > 0 Then

        With wks

            .Range("A" & x & ":A" & UBound(myArray) + 2) = WorksheetFunction.Transpose(myArray)

            Dim lRow As Long
            lRow = .Range("A" & x).End(xlDown).Row

            .Range("B" & x).Resize(1, 10).AutoFill _
                Destination:=.Range("B" & x).Resize(lRow, 10), Type:=xlFillDefault

        End With

    End If

    x = x + 17

Next