Excel：跨多個工作表填充數據

Question

對於我的僱主來說不幸的是，我的網絡工程課程中沒有包含高級Excel公式編程。不用說，我對Excel基本的SUM和COUNT公式命令一無所知。

我的老闆有一個Excel工作簿，裏面有多個工作表，代表着每個月的日曆年。我們希望能夠在工作簿中具有「總計」工作表，以反映每個列/行中整個工作簿中的所有數據。

爲清楚起見一個例子：

• 在工作表中 「May_2013」​​，列A被標記爲 「DATE」。單元格A2包含數據「MAY-1」。

• 在工作表「June_2013」​​中，A列標有「DATE」。單元格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. 在Project Explorer（畫面左側），展開的VBAProject上 「的ThisWorkbook」
3. 單擊鼠標右鍵，並選擇「查看代碼」
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」。我把圖片下面給你看我的參考名稱以及標籤名稱