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来完成这些工作所需的其他一些工作，以便为这次重新安排做好准备。但是，我已经在我的极限，写出了超级简单的“在其中找到带有'总'字样的行”。

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

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

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

Answer 1

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

enter image description here

我写了这个宏

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

产生这个结果： enter image description here

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

如何在重新排列细胞的同时组合反向时间片，防止堆叠？

1 个答案: