【问题标题】:Transposing an Array and Autofilling转置数组和自动填充
【发布时间】:2016-01-23 08:30:14
【问题描述】:

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

 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

【问题讨论】:

  • 查找最后一个单元格查看here
  • 如果我没记错的话,您链接的方法假定数据从列中的单元格 1 开始,没有任何标题来分解它。在给定的示例中,LastRow = .Range("E" & .Rows.Count).End(xlUp).Row 只会在 E 列的 ALL 中找到最后一个单元格,而不是特定范围。
  • 你说I'd like to auto-fill the formulas in columns B:K down to the last populated cell in column A所以你使用链接上的方法找到A列的最后一行然后填写到Range("B3:K" & lastrow)
  • for reference, I loop through this array ... 能否也包含代码的循环部分?以及定义标准的部分?我想我可以帮助你解决你的问题,但是循环和条件部分将帮助我确定变量以使其工作。
  • @ScottCraner 你把引用中最重要的部分留在了我所说的“A 列中最后填充的单元格中,用于该预定义范围(例如 A3:A17)”。所以,我想在单元格 A3:A17 之间找到最后一个填充的单元格。

标签: arrays excel transpose autofill vba


【解决方案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

【讨论】:

  • 抱歉,如果我造成混乱,我无法将代码很好地粘贴到 cmets 中,因此我使用循环标准编辑了我的原始问题。
  • 嗨,斯科特,非常感谢您的解决方案。它有一个警告:它似乎总是自动填充 A 列中最后一个填充单元格之后的两行。我操纵了我的数据(2 个条目、5 个条目等),它总是给我额外的两行 #N/来自我的vlookups。你知道为什么会这样吗?
  • 另外,我对 Resize 属性不太熟悉。如果我理解正确,它会从 B3:K3(10 列)获取数据并将行数调整为等于lRow 返回的行。我的理解是否正确?
  • 您的理解在@kschindl 上。我也只是更新了With wks 下的第一行。我之前没有把变量放在那里,现在我放了,所以一定要使用更新的代码。
  • 对于两个额外的单元格,您可以删除UBound(myArray) + 2) 语句中的+ 2,还是需要在其中?如果您确实需要它,请将lRow 行更改为lRow = .Range("A" & x).End(xlDown).Row - 2
猜你喜欢
  • 2021-09-27
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2010-10-29
  • 2017-07-14
  • 2019-08-08
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多