0

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

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

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

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

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

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

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

这可能吗？

4

3 回答 3

2

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

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

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

这两种解决方案都在您可以从该站点下载的工作簿中。使用 运行宏，然后从显示的选项列表中选择适当的宏。您可以通过调用 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
于 2013-04-10T18:54:18.627 回答
0

请使用 RDBMerge 插件，它将组合来自不同工作表的数据并为您创建一个主表。请参阅以下链接了解更多详情。

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

下载 RDBMerge

于 2013-04-10T17:26:49.417 回答
0

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

公式

于 2013-04-10T19:18:04.723 回答