自动将 Excel 工作表数据堆叠在新工作表中

Question

是否存在一个公式（可以是用户定义的 VBA 公式）可以自动将指定的工作表堆叠在一起？

由于相关的易失性性能问题，该公式不能涉及“间接”Excel 公式。

希望

有助于说明这个想法

Answer 1

“无挥发性”规则排除了很多可能性。如果您要允许 INDIRECT，那么有很多方法可以通过公式创建它而无需 VBA。即使使用 VBA，我怀疑每次 Sheets 1、2、... 发生变化时，您都必须使函数具有挥发性才能工作，但我不确定您的所有要求。

还有一种方法可以通过 Power Query 来实现这一点，它可以避免使用易失性变量，但每次要更新堆叠工作表时，您都必须保存文件，然后刷新表格。允许使用 OFFSET 将允许您使用 Power Query 和刷新功能，同时避免必须保存文件然后刷新。

方法：在每个包含要堆叠数据的工作表中，创建一个命名范围，其范围仅限于该工作表。

对于每个公式来说，其公式如下：

=OFFSET( $A$1, 0, 0, COUNTA($A:$A), 2 )

现在，在 B2 中输入“我想要堆叠的工作表（输入）”，通过键入单击该列表并按住 CTRL-T 来创建一个表格。告诉它您的表格有标题。我在单元格 A1 中创建了标题，如下所示：

这是一个动态表，它会随着您添加或删除工作表名称而自行调整大小。在“表设计”选项卡中，您可以将其从“表 1”重命名为更合乎逻辑的名称。我将我的表命名为 tS2Stack。

现在单击表格内的任意位置，转到“数据”选项卡，然后单击“从表格/范围”

这将打开 Power Query。在 Power Query 编辑器中，单击“新源”并选择“空白查询”。

它的默认名称是 Query1，但您可以随意重命名。我将其命名为 factStack。然后使用此脚本覆盖现有脚本。

let
  Source = Excel.CurrentWorkbook(),
  #"Filtered Rows" = Table.SelectRows(Source, each Text.Contains([Name], "_Drange")),
  #"Inserted Text Before Delimiter" = Table.AddColumn(#"Filtered Rows", "Text Before Delimiter", each Text.BeforeDelimiter([Name], "!"), type text),
  #"Merged Queries" = Table.NestedJoin(#"Inserted Text Before Delimiter", {"Text Before Delimiter"}, tS2Stack, {"Sheets to Stack"}, "tS2Stack", JoinKind.LeftOuter),
  #"Expanded tS2Stack" = Table.ExpandTableColumn(#"Merged Queries", "tS2Stack", {"Sheets to Stack"}, {"tS2Stack.Sheets to Stack"}),
  #"Filtered Rows1" = Table.SelectRows(#"Expanded tS2Stack", each ([tS2Stack.Sheets to Stack] <> null)),
  #"Removed Other Columns" = Table.SelectColumns(#"Filtered Rows1",{"Content"}),
  #"Expanded Content" = Table.ExpandTableColumn(#"Removed Other Columns", "Content", {"Column1", "Column2"}, {"Content.Column1", "Content.Column2"})
in
    #"Expanded Content"

从 Power Query 的“主页”选项卡中选择“关闭并加载”。您可以将表加载到您想要的位置。我将我的表与 tS2Stack 表并排放置。每当您想要更新它时，请右键单击并刷新它。

Answer 2

堆叠列

• 这是一个 VBA 解决方案。您只需运行StackColumns。

标准模块例如Module1

Option Explicit

Sub StackColumns()
    
    Const dName As String = "Stacked Sheets"
    Const drFirst As String = "A3" ' Read
    Const dwFirst As String = "B3" ' Write
    
    Const sFirst As String = "A1:B1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim wsData As Variant: wsData = GetColumns(dws.Range(drFirst))
    If IsEmpty(wsData) Then Exit Sub
    
    Dim cCount As Long: cCount = dws.Range(sFirst).Columns.Count
    Dim wsCount As Long: wsCount = UBound(wsData, 1)
    Dim sData As Variant: ReDim sData(1 To wsCount)
    Dim rData() As Long: ReDim rData(1 To wsCount)
    
    Dim sws As Worksheet
    Dim r As Long, drCount As Long, dwCount As Long
    For r = 1 To wsCount
        Set sws = Nothing
        On Error Resume Next
        Set sws = wb.Worksheets(wsData(r, 1))
        On Error GoTo 0
        If Not sws Is Nothing Then
            drCount = drCount + 1
            sData(drCount) = GetColumns(sws.Range(sFirst))
            If IsEmpty(sData(drCount)) Then
                drCount = drCount - 1
            Else
                rData(drCount) = UBound(sData(drCount))
                dwCount = dwCount + rData(drCount)
            End If
        End If
    Next r
    
    If drCount = 0 Then Exit Sub
    If wsCount > drCount Then
        ReDim Preserve sData(1 To drCount)
        ReDim Preserve rData(1 To drCount)
    End If
    
    Dim dData As Variant: ReDim dData(1 To dwCount, 1 To cCount)
    Dim c As Long, n As Long, d As Long
    
    For r = 1 To drCount
        For n = 1 To rData(r)
            d = d + 1
            For c = 1 To cCount
                dData(d, c) = sData(r)(n, c)
            Next c
        Next n
    Next r
    
    With dws.Range(dwFirst).Resize(, cCount)
        .Resize(dwCount).Value = dData
        .Resize(.Worksheet.Rows.Count - .Row - dwCount + 1) _
            .Offset(dwCount).ClearContents
    End With

End Sub

Function GetColumns( _
    ByVal FirstRowRange As Range) _
As Variant
    
    If FirstRowRange Is Nothing Then Exit Function
    
    Dim rg As Range
    Dim rCount As Long, cCount As Long
    With FirstRowRange.Rows(1)
        cCount = .Columns.Count
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If lCell Is Nothing Then Exit Function
        rCount = lCell.Row - .Row + 1
        Set rg = .Resize(rCount)
    End With
    
    Dim Data As Variant
    If rCount + cCount = 2 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    
    GetColumns = Data

End Function

工作表模块例如Stacked Sheets

• 为了进一步实现自动化，您必须将以下步骤添加到要运行此操作的工作表模块，即Stacked Sheets工作表的工作表模块。然后，只有当您手动或通过 VBA 代码（而不是通过公式）更改工作表名称范围内的值时，StackColumns才会自动运行。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const drFirst As String = "A3"
    Dim rg As Range
    With Me.Range(drFirst)
        Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1)
    End With
    If Not Intersect(rg, Target) Is Nothing Then
        StackColumns
    End If
End Sub

Answer 3

您可以使用 引用另一张工作表中的单元格=SheetName!A1，然后如果您将该公式复制并粘贴到下一行，它将自动转换为=SheetName!B1等等。可能有更优雅的方式来提取范围或使用 VBA，但在我花在摆弄它的时间里，这就是我能够工作的方法。在您找到更好的方法之前，作为一种稍微更手动的方法可能会有所帮助。