转置数组和自动填充

Question

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

 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

目标是转置数组，从 sheet "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 开始）设置 x 的 17 的因子，并将找到指定范围内从 '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

转置数组和自动填充

Transposing an Array and Autofilling

arrays

excel

vba

transpose

autofill

编辑（基于带循环的 OP 更新问题）