关于多表汇总的VBA

vicky427000

帮忙修改代码
一个EXCEL工作簿，里面有很多按照分表，我现在要根据所以表格C列的款号，做数据汇总，做在汇总表里，有些表格有如果有重复的款号，就要把重复款号的数据进行汇总，汇总数据主要是从K列到Q列，请写一个VBA代码


我的代码有问题，我要求汇总表从C列第四行开始填，就是不改变整个表的大框架汇总，然后K的数据填在K，不知道为什么我的数据都移动了 按款号汇总.rar (558.22 KB, 下载次数: 8)

2023-4-11 15:27 上传

点击文件名下载附件

Sub 数据汇总()
    Dim ws As Worksheet ' 分表的工作表
    Dim wsSummary As Worksheet ' 汇总表的工作表
    Dim rngSrc As Range ' 源数据范围
    Dim rngDest As Range ' 汇总数据范围
    Dim lastRow As Long ' 分表的最后一行
    Dim summaryRow As Long ' 汇总表的当前行
    Dim rowNum As Long ' 分表的行号
   
    ' 设置汇总表
    Set wsSummary = ThisWorkbook.Sheets("汇总表")
    summaryRow = 2 ' 从第 2 行开始写入汇总数据
   
    ' 遍历每个分表
    For Each ws In ThisWorkbook.Sheets
        ' 排除汇总表
        If ws.Name <> "汇总表" Then
            ' 获取分表的最后一行
            lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
            
            ' 设置源数据范围
            Set rngSrc = ws.Range("C1:C" & lastRow)
            
            ' 遍历源数据范围
            For rowNum = 1 To rngSrc.Rows.Count
                ' 判断款号是否为空
                If Not IsEmpty(rngSrc.Cells(rowNum, 1)) Then
                    ' 判断汇总表是否已存在相同款号的数据
                    If wsSummary.Range("A:A").Find(rngSrc.Cells(rowNum, 1).Value, , xlValues, xlWhole) Is Nothing Then
                        ' 汇总数据写入汇总表
                        wsSummary.Cells(summaryRow, 1).Value = rngSrc.Cells(rowNum, 1).Value ' 款号
                        wsSummary.Cells(summaryRow, 2).Value = ws.Name ' 分表名称
                        wsSummary.Cells(summaryRow, 3).Value = ws.Cells(rowNum, 11).Value ' K 列数据
                        wsSummary.Cells(summaryRow, 4).Value = ws.Cells(rowNum, 12).Value ' L 列数据
                        wsSummary.Cells(summaryRow, 5).Value = ws.Cells(rowNum, 13).Value ' M 列数据
                        wsSummary.Cells(summaryRow, 6).Value = ws.Cells(rowNum, 14).Value ' N 列数据
                        wsSummary.Cells(summaryRow, 7).Value = ws.Cells(rowNum, 15).Value ' O 列数据
                        wsSummary.Cells(summaryRow, 8).Value = ws.Cells(rowNum, 16).Value ' P 列数据
                        wsSummary.Cells(summaryRow, 9).Value = ws.Cells(rowNum, 17).Value ' Q 列数据
                        summaryRow = summaryRow + 1 ' 下一行
                    Else
                        ' 如果汇总表已存在相同款号的数据，则进行汇总
                        Dim destRow As Range
                        Set destRow = wsSummary.Range("A:A").Find(rngSrc.Cells(rowNum, 1).Value, , xlValues, xlWhole).Offset(0, 2) ' 汇总表款号


                        ' 进行汇总
                        destRow.Value = destRow.Value + ws.Cells(rowNum, 11).Value ' K 列数据
                        destRow.Offset(0, 1).Value = destRow.Offset(0, 1).Value + ws.Cells(rowNum, 12).Value ' L 列数据
                        destRow.Offset(0, 2).Value = destRow.Offset(0, 2).Value + ws.Cells(rowNum, 13).Value ' M 列数据
                        destRow.Offset(0, 3).Value = destRow.Offset(0, 3).Value + ws.Cells(rowNum, 14).Value ' N 列数据
                        destRow.Offset(0, 4).Value = destRow.Offset(0, 4).Value + ws.Cells(rowNum, 15).Value ' O 列数据
                        destRow.Offset(0, 5).Value = destRow.Offset(0, 5).Value + ws.Cells(rowNum, 16).Value ' P 列数据
                        destRow.Offset(0, 6).Value = destRow.Offset(0, 6).Value + ws.Cells(rowNum, 17).Value ' Q 列数据
                    End If
                End If
            Next rowNum
        End If
    Next ws
   
    MsgBox "数据汇总完成！", vbInformation
End Sub

vicky427000

请大家帮忙看看，谢谢哈

vicky427000

大家帮忙看看，我这个汇总怎么修改代码，因为我也看不懂

ykcbf1100

这个代码其实没什么好说的，用数组的话，速度会快很多。
另外，这个代码前几天刚在论坛求助过啊，当时帮改写了代码，现在又求助了？

仙女配凡人

数据汇总都用数组 + 字典完成，不太懂VBA，用JS代码重写了，需要WPS2022才能用

1. function test_data()
   
2. {
   
3.   //获取所有分表数据
   
4.   let data = [];
   
5.   for (let sht of Worksheets)
   
6.   {
   
7.     if (sht.Name != '汇总表')
   
8.     {
   
9.       let arr = sht.Range('A3').CurrentRegion.Value2;
   
10.       data = data.concat(arr.slice(3))
    
11.     }
    
12.    
    
13.   }
    
14. 
    
15.   //汇总分表数据
    
16.   const obj = {};
    
17.   const col = [10, 11, 12, 13, 14, 15, 16]; //K-Q 列
    
18.   data.forEach(i => {
    
19.     let f = i[2]; //按款式汇总
    
20.     if (obj[f])
    
21.     {
    
22.       col.forEach(o => {
    
23.         let x = obj[f][o] || 0;
    
24.         let y = i[o] || 0;
    
25.         obj[f][o] = Number(x) + Number(y)
    
26.       })
    
27. 
    
28.     } else {
    
29.       obj[f] = i //一维数组
    
30.     }
    
31.    
    
32.   })
    
33. 
    
34.   //处理数据
    
35.   let arr = [];
    
36.   let sht = Sheets('汇总表');
    
37.   for (let i in obj) arr.push(obj[i]);
    
38.   sht.Range('A4').Resize(arr.length, arr[0].length).Value2 = arr
    
39. 
    
40. }

复制代码

3190496160

这种代码，直接操作单元格，效率不高的，没有多少修改的价值，不如具体描述你的需求，也许可以考虑重新写代码的

fanyoulin

这个简单，我感觉你这种数据量应该不会大，所以就直接写单元格了，没用数组。如果数据量很大，你自己再改成数组好了。
测试时清屏出现失误，把标题搞丢了，你再补吧。

vicky427000

因为数据量很大，之前用的公式基本就不动，所以才想要改用代码

vicky427000

ykcbf1100 发表于 2023-4-12 10:37
这个代码其实没什么好说的，用数组的话，速度会快很多。
另外，这个代码前几天刚在论坛求助过啊，当时帮改 ...

我第一次发，好像，这个数组公式基本就跑不动，很费时间，可能数据量太大了，我发的只是个测试模板

ykcbf1100

vicky427000 发表于 2023-4-14 13:33
我第一次发，好像，这个数组公式基本就跑不动，很费时间，可能数据量太大了，我发的只是个测试模板

但你发的代码，论坛中前几天就见过了。
处理数据尽量用数组+字典，尽量不要对单元格直接操作，否则，速度就慢。

这个代码，我当时都用数组重写过的，你可以找找看。