VBA多表行列数据累加

'统计多个excel表格的数据,每个行列值累加汇总到一个表格中
Sub huizong()
    '存放文件的目录
    dirPath = "C:\Users\zhaigx\Desktop\1"
    fname = Dir(dirPath & "\" & "*.xls")
    dataSrc="D7:Y49"
    
    'Dim fileNameArr(20) As String
    Dim f As String
    
    '获取文件列表    
    '创建一个字典对象,将目录下文件放入字典的key中
    Set DicList = CreateObject("Scripting.Dictionary")
    While fname <> ""
        'Debug.Print "fileName: "; fname
        '增加key,value
        DicList.Add fname, ""
        fname = Dir
    Wend
    
    fileNameList = DicList.Keys
    
    Debug.Print "文件数: " & DicList.Count
    
    '声明一动态二维数组
    Dim totalRC() As Variant
    Dim rowSize
    Dim colSize
    
    flag = True
    
    '循环读取多个excel文件
    For Each fileNameKey In fileNameList
        f = dirPath & "\" & fileNameKey
        Debug.Print "### " & f
        
        Set wb = Workbooks.Open(f)
        Set rg = wb.Sheets(1).Range(dataSrc)
        
        '获取一个表格数据的行列数,设置明确最终数据的行列数,只赋值一次,用于初始化累计值的数组
        If (flag) Then
            rowSize = rg.Rows.Count
            colSize = rg.Columns.Count
            '明确数组大小
            ReDim totalRC(rowSize, colSize)
            flag = False
        End If
                    
        
        For r = 1 To rowSize
            For c = 1 To colSize
            '获取第r行第c列的数据值,累加到totalRC数组中
               totalRC(r, c) = totalRC(r, c) + rg.Item(r, c)
            Next
            
        Next
        '关闭文件    
        wb.Close False
    Next
    
   
    
    '最终得到的数据,写入到test标签页中
    Debug.Print "行数 列数: "; rowSize; colSize
    '先清空test标签中的数据,再写入新数据
    ThisWorkbook.Worksheets("test").UsedRange.ClearContents
    For i = 1 To rowSize
        For j = 1 To colSize
            'Debug.Print i; j; totalRC(i, j)
            ThisWorkbook.Worksheets("test").Cells(i, j).Value = totalRC(i, j)
        Next      
    Next
    
End Sub

 


版权声明:本文为tower888原创文章,遵循CC 4.0 BY-SA版权协议,转载请附上原文出处链接和本声明。