Excel：填充多个工作表中的数据 [英] Excel: Populate Data Across Multiple Worksheets

问题描述

不幸的是，对于我的雇主，我的网络工程课程都没有包括高级Excel公式编程。不用说，对于基本的SUM和COUNT公式命令，我不知道Excel保存。

Unfortunately for my employer, none of my network engineering courses included advanced Excel formula programming. Needless to say, I know nothing about Excel save for basic SUM and COUNT formula commands.

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

My employer has an Excel workbook with multiple worksheets within it representing each month of the calendar year. We want to be able to have a "total" worksheet in the workbook that reflects all data across the entire workbook in each column/row.

为了清晰度：

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

• In the worksheet "May_2013", column A is labeled "DATE". Cell A2 contains the data "MAY-1".

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

In the worksheet "June_2013", column A is labeled "DATE". Cell A2 contains the data "JUNE-1".

在工作表总计中，A列标记为DATE。我们想要单元格A2反映MAY-1和A3反映JUNE-1。

In the worksheet "Total", column A is labeled "DATE". We want cells A2 to reflect "MAY-1" and A3 to reflect "JUNE-1".

为所有工作表，列AQ，行2-33列表填写最终的主表，其中包含相应列中所有工作表中的所有数据。

We want to do this for all worksheets, columns A-Q, rows 2-33 and populate a master sheet at the very end containing all data in all worksheets in their corresponding columns.

是这可能吗？

推荐答案

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

Here are two VBA solutions. The first does this:

1. 检查表格总计是否存在。如果没有，创建它


2. 将第一页的第一行（A到Q）复制到总计


3. 将块A2：Q33复制到


4. 对所有其他工作表重复一次，每次下降32行

1. Check if a sheet "totals" exists. Create it if it does not
2. Copy the first row (A to Q) of first sheet to "totals"
3. Copy block A2:Q33 to "totals" sheet starting at row 2
4. Repeat for all other sheets, appending 32 rows lower each time

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

The second shows how to do some manipulation of the column data before copying: for each column it applies the WorksheetFunction.Sum(), but you could replace that with any other aggregating function that you would like to use. It then copies the result (one row per sheet) to the "totals" sheet.

这两个解决方案都在您可以下载的工作簿中来自本网站。运行宏，并从显示的选项列表中选择适当的宏。您可以通过调用VBA编辑器来编辑代码。

Both solutions are in the workbook you can download from this site. Run the macros with , and pick the appropriate one from the list of options that shows up. You can edit the code by invoking the VBA editor with .

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 事件通过添加代码到工作簿。你可以这样做：

Final(?) edit: If you want this script to run automatically every time someone makes a change to the workbook, you can capture the SheetChange event by adding code to the workbook. You do this as follows:

1. 打开Visual Basic编辑器（）


2. 在项目浏览器中（屏幕左侧），展开VBAProject


3. 右键单击ThisWorkbook，然后选择查看代码


4. 在窗口打开，复制/粘贴以下代码行：

1. open the Visual Basic editor ()
2. In the project explorer (left hand side of the screen), expand the VBAProject
3. Right-click on "ThisWorkbook", and select "View Code"
4. In the window that opens, copy/paste the following lines of code:

这篇关于Excel：填充多个工作表中的数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！