如何结合反向按时间顺序排列单元格，防止堆叠？

好的，我会尽力解释这一点。 一个奇怪的问题要解决，这是超越我的技能水平（新手）的方式。 Excel 2011 for Mac。

工作簿有11张。 工作表名称都是“Month Year”。 （例如：表格1标题为“2013年6月”）表格名称是反向时间顺序的。 （2013年6月，2013年5月，2013年4月等）每张纸都有相同布局的数据：A1是纸张的名称。 B1到B上的不同终点保持date。 （大约两周，但在两张纸之间变化很大），A2和A中的所有名称都是“最后一个”。 B1和向外的其余列是空的，0或1（第1行的出席date）。

我需要做的是：在一张表中获取所有的数据，date按照时间顺序排列，按照字母顺序排列，顺序排列在列A中。 不用搞乱名称与存在的0/1 /空白值之间的关联在原始的工作表上。

我所做的：我在一个非常相似的表单上使用Excel GUI手动执行了这个操作。 它花了永远！ 我也一直在写或采购Subs来完成这些工作表所需的其他工作，以便为这个大型重新安排做好准备。 但是我已经在写作超级简单的极限了，“用”总“这个单词在他们身上find各种各样的东西。

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

从最早的工作表开始，复制到新工作表（YearSheet）中。 从2ndOldest取名，粘贴到已有的名字下。 把date和他们下面的单元格放到YearSheet中，但是在列上交错排列，所以他们从第一张纸离开的地方开始。 再次与下一个最年轻，同样的交易重复。 名称，date和数据下的名称沿字母轴推出，以防止与之前的date重叠。 最后是A中的一长串名称，剩下的是数据块的递减步骤模式。 按字母顺序排列。 find并压缩相同的名称到一行， 而不会丢失数据（为什么Excel只保留左上angular？Aaargh！）

所以，我知道在这里要问很多。 不知道这个问题是否太多或者太高，但是我只是难住，所以发布它希望有人可以理解的VBA做到这一点。

Answer 1

我根据您的描述创build了一个工作手册，用作示例数据。

我写了这个macros

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 

这产生了这个结果：

这是在Excel 2010中编写的。 我不知道PC和Mac版本之间有什么区别，但这可能适用于您。