VBA文件批量操作1-12个文件进行数据条件求和

Excel_VBA创维大表格จุ๊บ

于 2024-02-05 15:47:42 发布

阅读量521

点赞数 9

分类专栏： excel VBA 大表格工具箱文章标签： python 算法数据库 VBA 数据批量汇总

本文链接：https://blog.csdn.net/weixin_44681501/article/details/136043042

版权

VBA 同时被 3 个专栏收录

16 篇文章 1 订阅

订阅专栏

excel

5 篇文章 0 订阅

订阅专栏

大表格工具箱

4 篇文章 0 订阅

订阅专栏

文章分享了一个使用VBA编写的Excel宏，用于处理多个CSV文件中的数据，通过字典存储区ID对应的归属类别，对特定条件下的数据进行计算并更新到Excel工作簿中。

摘要由CSDN通过智能技术生成

今天帮客户改良修复问题，发现这个案例挺好，分享一个批量操作文件的功能代码

有相关需求的可以复制修改，希望能帮助到大家

下面是相关代码


Sub 数据计算()

On Error Resume Next    '忽略错误
ReDim brr(1 To 4, 1 To 4)   '定义长一个4个位置高4个位置的正方形盒子
pth = ThisWorkbook.Path & "\"   '定义文件夹路径为本文件所在的文件夹

    Set d = CreateObject("scripting.dictionary")    '定义一个字典，用来存储数据
    Set wb = GetObject(pth & "QU此文件.xlsx")       '打开获取本工作簿文件夹下的【QU此文件.xlsx】文件的数据
    With wb     '操作QU此文件.xlsx工作簿的第1个表
        With .Sheets(1)
            r = .Cells(.Rows.Count, 1).End(3).Row   '获取QU此文件.xlsx工作簿的第1个表的最后一行
            arr = .Cells(1, 1).Resize(r, 3).Value2  '存入arr数组
            
            '一个一个数据，将A列的数据的单引号替换删除后，存入字典，字典就是相当于钥匙和锁，将区ID对应不同归属和类别存入字典，方便提取
            For i = r To 2 Step -1
                d(Replace(arr(i, 1), "'", "") & "") = arr(i, 2) & arr(i, 3)
            Next
        End With
        .Close False    '操作完QU此文件.xlsx工作簿就关闭
    End With
    
    '开始处理1-12的12个csv文件，逐个打开处理数据，将里面的数据进行处理
    For N = 1 To 12
        If Dir(pth & N & ".csv") = "" Then GoTo line
        Set wb = GetObject(pth & N & ".csv")

        With wb: With .Sheets(1)
            r = .Cells(.Rows.Count, 1).End(xlUp).Row
            arr = .Cells(1, 1).Resize(r, 20).Value2     '将数据存入数组待处理
            For i = 3 To r      '遍历3到最后一行
                'MsgBox d(Left(arr(i, 1), 15)) '& dw(d(Left(arr(i, 1), 15)) & "")
                j = dw(d(Left(arr(i, 1), 15)) & "") '截取A列的15位字符串 ，获取区ID对应的归属和类别，再调用dw函数，判断对应的归属类别是 盛成dw=1、盛农dw=2、世成dw=3、世农dw=4
                If j Then
                    If Left(arr(i, 8), 2) = "21" Or Left(arr(i, 8), 2) = "41" Or Left(arr(i, 8), 4) = "5324" Then '将21开头或者41开头或者5324开头的，正方形的第1行对应dw列=正方形的第1行dw列本身+csv文件J列的数值
                        brr(1, j) = brr(1, j) * 1 + arr(i, 10) * 1
                    ElseIf Left(arr(i, 8), 2) = "12" Or Left(arr(i, 8), 2) = "22" Then  '如果csv文件的H列是12开头、或者22开头，则放在正方形第二行dw列=正方形的第2行dw列本身+csv文件J列的数值
                        brr(2, j) = brr(2, j) * 1 + arr(i, 10) * 1
                    ElseIf arr(i, 8) Like "13*" Or arr(i, 8) Like "51*" Or arr(i, 8) Like "4231*" Or arr(i, 8) Like "4241*" Then
                        brr(2, j) = brr(2, j) * 1 - arr(i, 10) * 1
                    ElseIf arr(i, 8) Like "23*" Then
                        brr(3, j) = brr(3, j) * 1 + arr(i, 10) * 1
                    ElseIf arr(i, 8) Like "52*" Or arr(i, 8) Like "542*" Then
                        brr(3, j) = brr(3, j) * 1 - arr(i, 10) * 1
                    ElseIf arr(i, 8) Like "24*" Then
                        brr(4, j) = brr(4, j) * 1 + arr(i, 10) * 1
                    ElseIf arr(i, 8) Like "53*" Or arr(i, 8) Like "544*" Then
                        brr(4, j) = brr(4, j) * 1 - arr(i, 10) * 1
                    End If
                End If
            Next
        End With: .Close False: End With
line:
    Next
    
    Range("B8:E11").Value2 = brr: MsgBox "计算完成！"
End Sub
Function dw%(s)
    If s = "盛成" Then dw = 1
    If s = "盛农" Then dw = 2
    If s = "世成" Then dw = 3
    If s = "世农" Then dw = 4
End Function