1

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

工作簿有 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 只保留左上角？Aaargh！）

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

4

1 回答 1

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 版本之间有什么区别，但这可能对你有用。

于 2013-07-30T17:26:22.227 回答