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

目标是将单元格A3中的数组转置到工作表“Delta Summary”上。我的代码完成了这个，但我想知道是否有更好的方法来做到这一点。作为参考，我循环遍历此数组并根据不同的标准将其转置几次。我从单元格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行限制内）。

下面将再次遍历数组，并为每个循环设置一个17到x的因子（从3开始），并且将在指定范围内找到最后一行，从＆＃39; Bx＆＃39;开始。并使用.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

转置数组和自动填充

1 个答案:

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