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

3 回答

• 2

  这是两个VBA解决方案 . 第一个做到这一点：

  • 检查是否存在工作表"totals" . 如果没有，请创建它

  • 将第一张纸的第一行（A到Q）复制到"totals"

  • 从第2行开始复制块A2：Q33到"totals"表

  • 对所有其他工作表重复，每次减少32行

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

  这两种解决方案都在工作簿中，您可以下载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
  

  Final(?) edit: 如果希望每次有人对工作簿进行更改时都自动运行此脚本，则可以通过向工作簿添加代码来捕获 SheetChange 事件 . 你这样做如下：

  • 打开Visual Basic编辑器（）

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

  • 右键单击"ThisWorkbook"，然后选择"View Code"

  • 在打开的窗口中，复制/粘贴以下代码行：

  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
  

  回复于 2024-04-29T01:32:38+08:00
• 0

  请使用RDBMerge加载项，它将组合来自不同工作表的数据并为您创建主表 . 有关详细信息，请参阅以下链接 .

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

  Download RDBMerge

  回复于 2024-04-29T01:32:38+08:00
• 0

  您可以使用间接功能来引用工作表名称 . 在下图中，此功能采用 Headers 名称（B37）并将其用作图纸参考 . 你所要做的就是选择正确的“总细胞”，我在“MAY_2013”中制作了“A1” . 我在下面放了一个图像，显示我的参考名称和标签名称

  

  回复于 2024-04-29T01:32:38+08:00