转置arrays和自动填充

我正在寻找一种更有效的，不太硬编码的方式来转置一个数组，然后在相邻列中自动填充公式。 这里是我目前的代码转置我的数组在表单上的特定点和自动填充列：

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中的数组。 我的代码完成了这一点，但我想知道是否有更好的方法来做到这一点。 作为参考，我循环这个数组并根据不同的标准转置几次。 我将从arraysA3，A20，A37，…和A224开始的arrays转置。 每个部分有15个单元格分配给数据。

至于自动填充，我想自动填充公式列B：K到列A的最后填充的单元格为该预定义的范围（如A3：A17，A20：34，等等）。 我不知道如何find最后一个预先定义的范围的填充单元格，所以我有这个硬编码。

我还在学习，所以任何有识之士将不胜感激！

编辑：这是我用来填充我的数组的循环标准的一个例子：

 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更新问题与循环）

从构build数组的方式来看，似乎数组正在加载数据范围的最后一行，以便为每个范围复制（在15行限制内）。

下面的代码将循环遍历数组，并将为每个循环（从3开始）设置一个17到x的因子，并将find从'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