如何在重新排列单元格的同时合并逆时序表，防止堆叠？

Question

好的，我会尽力解释清楚。一个奇怪的问题要解决，它超出了我的技能水平（新手）。 Excel 2011 for Mac。

工作簿有 11 张。 工作表名称都是“月年”。 （例如：表 1 的标题为“2013 年 6 月”） 工作表名称按时间倒序排列。 （2013 年 6 月、2013 年 5 月、2013 年 4 月等） 每个工作表都有相同布局的数据： A1 是工作表的名称。 B1 到 B 保留日期的不同端点。 （大约两周，但纸张之间差异很大） A2 和 A 中的下方是所有名称，如“last,first”。 B1 下方和外部的其余列是空白、0 或 1（第 1 行的日期出席）。

我需要做的： 在一张表中获取所有数据，日期沿第 1 行按时间顺序排列，名称按字母顺序排列在 A 列下方。不弄乱名称和 0/1/空白值之间的关联存在于原始工作表上。

我做了什么： 我在一张非常相似的工作表上使用 Excel GUI 手动完成了这项工作。它花了很长时间！ 我也一直在编写或采购 Subs 来完成这些工作表所需的其他一些工作，以使它们为这次大的重新排列做好准备。但我已经在我的极限写超级简单的“查找包含单词'total'的行”之类的东西。

我知道在这里做什么，但不知道怎么做。

从最旧的工作表开始，复制到新工作表（YearSheet）。 从 2ndOldest 取名字，粘贴到 A 中已经存在的名字下。 将日期和它们下面的单元格放入 YearSheet，但在列上交错排列，以便它们从第一张表停止的地方开始。 与 nextYoungest 再次重复，同样的交易。姓名、日期和数据下的姓名沿字母轴突出，以防止与以前的日期重叠。 最终，它是 A 中的一长串名称，其余部分是数据块的降序步进模式。 按字母顺序对所有内容进行排序。 查找相同的名称并将其压缩到一行中，不会沿途丢失数据（为什么 Excel 只保留左上角？哎呀！）

所以，我知道这里有很多问题要问。 不知道这对于一个问题来说是否过多或过分，但我只是被难住了，所以发布它是希望有人能理解 VBA 来做到这一点。

Answer 1

我根据您的描述创建了一个工作簿用作示例数据。

这个宏是我写的

Sub Main()
    Dim CombinedData As Variant
    Dim TotalCols As Integer
    Dim TotalRows As Long
    Dim PasteCol As Integer
    Dim PasteRow As Long
    Dim i As Integer
    Dim PivSheet As Worksheet


    ThisWorkbook.Sheets.Add Sheet1
    On Error GoTo SheetExists
    ActiveSheet.Name = "Combined"
    On Error GoTo 0
    Range("A1").Value = "Name"

    For i = ThisWorkbook.Sheets.Count To 1 Step -1
        If Sheets(i).Name <> "Combined" Then

            Sheets(i).Select
            TotalCols = Sheets(i).Columns(Columns.Count).End(xlToLeft).Column
            TotalRows = Sheets(i).Rows(Rows.Count).End(xlUp).Row
            PasteCol = PasteCol + TotalCols - 1
            If PasteRow = 0 Then
                PasteRow = 2
            Else
                PasteRow = PasteRow + TotalRows - 1
            End If

            'Copy Date Headers
            Range(Cells(1, 2), Cells(1, TotalCols)).Copy Destination:=Sheets("Combined").Cells(1, PasteCol)

            'Copy Names
            Range(Cells(2, 1), Cells(TotalRows, 1)).Copy Destination:=Sheets("Combined").Cells(PasteRow, 1)

            'Copy Data
            Range(Cells(2, 2), Cells(TotalRows, TotalCols)).Copy Destination:=Sheets("Combined").Cells(PasteRow, PasteCol)
        End If
    Next

    Sheets("Combined").Select
    ActiveSheet.Columns.AutoFit
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1"), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending, _
                        DataOption:=xlSortNormal
        .SetRange ActiveSheet.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    Set PivSheet = Sheets.Add
    ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                    SourceData:=Sheets("Combined").UsedRange, _
                                    Version:=xlPivotTableVersion14).CreatePivotTable _
                                    TableDestination:=PivSheet.Range("A1"), _
                                    TableName:="PivotTable1", _
                                    DefaultVersion:=xlPivotTableVersion14


    For i = 1 To PivSheet.PivotTables("PivotTable1").PivotFields.Count
        With ActiveSheet.PivotTables("PivotTable1")
            If i = 1 Then
                .PivotFields(i).Orientation = xlRowField
                .PivotFields(i).Position = 1
            Else

                ActiveSheet.PivotTables("PivotTable1").AddDataField .PivotFields(i), _
                                                                    "Sum of " & .PivotFields(i).Name, _
                                                                    xlSum
            End If
        End With
    Next

    Application.DisplayAlerts = False
    Sheets("Combined").Delete
    Application.DisplayAlerts = True

    PivSheet.Name = "Combined"
    CombinedData = ActiveSheet.UsedRange
    Cells.Delete
    Range(Cells(1, 1), Cells(UBound(CombinedData), UBound(CombinedData, 2))).Value = CombinedData
    Range("A1").Value = "Name"
    Range(Cells(1, 1), Cells(1, UBound(CombinedData, 2))).Replace "Sum of ", ""
    Columns.AutoFit
    Exit Sub

SheetExists:
    Application.DisplayAlerts = False
    Sheets("Combined").Delete
    Application.DisplayAlerts = True
    Resume
End Sub

产生这个结果：

这是在 Windows 中的 Excel 2010 中编写的。我不知道 pc 和 mac 版本之间有什么区别，但这可能对你有用。