Excel：跨多个工作表填充数据

Question

对我的雇主来说很遗憾，我的网络工程课程中没有一门包含高级 Excel 公式编程。不用说，除了基本的 SUM 和 COUNT 公式命令外，我对 Excel 一无所知。

我的雇主有一个 Excel 工作簿，其中包含多个工作表，代表日历年的每个月。我们希望能够在工作簿中拥有一个“总计”工作表，以反映整个工作簿中每一列/行中的所有数据。

为了清楚起见，举个例子：

• 在工作表“May_2013”​​中，A 列标记为“日期”。单元格 A2 包含数据“MAY-1”。

• 在工作表“June_2013”​​中，A 列标记为“日期”。单元格 A2 包含数据“JUNE-1”。

• 在工作表“总计”中，A 列标记为“日期”。我们希望单元格 A2 反映“MAY-1”，而 A3 反映“JUNE-1”。

我们希望对所有工作表、A-Q 列、第 2-33 行执行此操作，并在最后填充一个主工作表，其中包含所有工作表中相应列中的所有数据。

这可能吗？

Answer 1

这里有两个 VBA 解决方案。第一个这样做：

1. 检查工作表“总计”是否存在。如果没有，则创建它
2. 将第一张工作表的第一行（A 到 Q）复制到“总计”
3. 将块 A2:Q33 复制到从第 2 行开始的“总计”表
4. 对所有其他工作表重复此操作，每次向下追加 32 行

第二个展示了如何在复制之前对列数据进行一些操作：对于每一列，它应用WorksheetFunction.Sum()，但您可以将其替换为您想使用的任何其他聚合函数。然后它将结果（每张纸一行）复制到“总计”表格中。

这两种解决方案都在您可以下载from this site 的工作簿中。使用 运行宏，然后从显示的选项列表中选择适当的宏。您可以通过调用 VBA 编辑器来编辑代码。

Sub aggregateRaw()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range

sheetCount = ActiveWorkbook.Sheets.Count

' add a new sheet at the end:
If Not worksheetExists("totals") Then
  Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
  newSheet.Name = "totals"
Else
  Set newSheet = ActiveWorkbook.Sheets("totals")
End If

Set targetRange = newSheet.[A1]

' if you want to clear the sheet before copying data, uncomment this line:
' newSheet.UsedRange.Delete

' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
ActiveWorkbook.Sheets(1).Range("1:1").Copy targetRange

Set targetRange = targetRange.Offset(1, 0) ' down a row
' copy blocks of data from A2 to Q33 into the "totals" sheet
For Each ws In ActiveWorkbook.Worksheets
  If ws.Name <> newSheet.Name Then
    ws.Range("A2", "Q33").Copy targetRange
    Set targetRange = targetRange.Offset(32, 0) ' down 32 rows
  End If
Next ws

End Sub

Sub aggregateTotal()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
Dim columnToSum As Range

sheetCount = ActiveWorkbook.Sheets.Count

' add a new sheet at the end:
If Not worksheetExists("totals") Then
  Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
  newSheet.Name = "totals"
Else
  Set newSheet = Sheets("totals")
End If

' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
Set targetRange = newSheet.[A1]
ActiveWorkbook.Sheets(1).Range("A1:Q1").Copy targetRange

Set targetRange = targetRange.Offset(1, 0) ' down a row

For Each ws In ActiveWorkbook.Worksheets
  ' don't copy data from "total" sheet to "total" sheet...
  If ws.Name <> newSheet.Name Then
    ' copy the month label
    ws.[A2].Copy targetRange

    ' get the sum of the coluns:
    Set columnToSum = ws.[B2:B33]
    For colNum = 2 To 17 ' B to Q
      targetRange.Offset(0, colNum - 1).Value = WorksheetFunction.Sum(columnToSum.Offset(0, colNum - 2))
    Next colNum
    Set targetRange = targetRange.Offset(1, 0) ' next row in output
  End If

Next ws

End Sub

Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function

最终（？）编辑： 如果您希望每次有人对工作簿进行更改时自动运行此脚本，您可以通过向工作簿添加代码来捕获SheetChange 事件。你可以这样做：

1. 打开 Visual Basic 编辑器 ()
2. 在项目浏览器（屏幕左侧）中，展开 VBAProject
3. 右键单击“ThisWorkbook”，然后选择“查看代码”
4. 在打开的窗口中，复制/粘贴以下代码行：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) ' handle errors gracefully: On Error GoTo errorHandler ' turn off screen updating - no annoying "flashing" Application.ScreenUpdating = False ' don't respond to events while we are updating: Application.EnableEvents = False ' run the same sub as before: aggregateRaw ' turn screen updating on again: Application.ScreenUpdating = True ' turn event handling on again: Application.EnableEvents = True Exit Sub ' if we encountered no errors, we are now done. errorHandler: Application.EnableEvents = True Application.ScreenUpdating = True ' you could add other code here... for example by uncommenting the next two lines ' MsgBox "Something is wrong ... " & Err.Description ' Err.Clear End Sub

Answer 2

请使用 RDBMerge 插件，它将结合来自不同工作表的数据并为您创建一个主表。详情请查看以下链接。

http://duggisjobstechnicalstuff.blogspot.in/2013/03/how-to-merge-all-excel-worksheets-with.html

Download RDBMerge

Answer 3

您可以使用间接函数来引用工作表名称。在下图中，此函数采用标题名称 (B37) 并将其用作工作表参考。您所要做的就是选择我在“MAY_2013”​​中制作的“A1”正确的“总单元格”。我在下面放了一张图片，向您展示我的参考名称以及标签名称