首页 > 其他 > 详细

多工作簿合并计算

时间:2018-10-06 12:28:12      阅读:188      评论:0      收藏:0      [点我收藏+]
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

(0)
(0)
   
举报
评论 一句话评论(0
关于我们 - 联系我们 - 留言反馈 - 联系我们:wmxa8@hotmail.com
© 2014 bubuko.com 版权所有
打开技术之扣,分享程序人生!