Public Sub QuickConsolidateMethod() ‘声明变量 Dim Wb As Workbook, OpenWb As Workbook Dim Sht As Worksheet, OneSht As Worksheet Dim Rng As Range, OneRng As Range, RangeAddress As String Const SHEET_INDEX = 1 Const RANGE_ADDRESS = "C5:L17" Dim FirstCell As Range Dim Arr() As String ReDim Arr(1 To 1) Dim FolderPath, FileName, FileIndex ‘设置对象 Set Wb = Application.ThisWorkbook Set Sht = Wb.ActiveSheet Set Rng = Sht.Range(RANGE_ADDRESS) Set FirstCell = Rng.Cells(1, 1) ‘合计结果输出位置的左上角 RangeAddress = Rng.Address(ReferenceStyle:=xlR1C1) ‘选用指定格式的单元格地址 FolderPath = Wb.Path & "\各部门\" ‘各部门工作簿文件夹 FileIndex = 0 FileName = Dir(FolderPath & "*.xls*") Do While FileName <> "" FileIndex = FileIndex + 1 ReDim Preserve Arr(1 To FileIndex) Set OpenWb = Application.Workbooks.Open(FolderPath & FileName) ‘若工作表已经有统一名称,则不需要打开 Set OneSht = OpenWb.Worksheets(SHEET_INDEX) Arr(FileIndex) = "‘" & FolderPath & "[" & FileName & "]" & OneSht.Name & "‘!" & RangeAddress ‘构造引用地址 OpenWb.Close False ‘关闭文件 FileName = Dir Loop ‘执行合并计算方法 FirstCell.Consolidate Sources:=Arr, Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False ‘释放对象 Set Wb = Nothing: Set Sht = Nothing Set Rng = Nothing: Set OpenWb = Nothing Set OneSht = Nothing End Sub
原文地址:https://www.cnblogs.com/nextseven/p/9746919.html
时间: 2024-10-04 12:29:53