zoukankan      html  css  js  c++  java
  • 多工作簿合并计算

    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
    

      

  • 相关阅读:
    获取MAC地址的几种方式
    从0到100——知乎架构变迁史
    CSS3必须要知道的10个顶级命令
    leetcode: 3Sum Closest
    leetcode: 3Sum
    leetcode: Longest Common Prefix
    leetcode: Roman to Integer
    leetcode: Integer to Roman
    leetcode: Container With Most Water
    leetcode: Regular Expression Matching
  • 原文地址:https://www.cnblogs.com/nextseven/p/9746919.html
Copyright © 2011-2022 走看看