复杂的多表汇总(难度有点大,做出来有分加哦)

greview

爱吃蜂蜜的狼 发表于 2019-5-17 16:23

请你帮忙给我看看 这个检查表的汇总和大神写的程序 要实现的目的一样 ，能不能帮我修改成我需要的，检查表1200张，每周汇总一次，谢谢

greview

笨鸟飞不高 发表于 2021-5-25 14:00

请你帮忙给我看看 这个检查表的汇总和大神写的程序 要实现的目的一样 ，能不能帮我修改成我需要的，检查表1200张，每周汇总一次，谢谢

笨鸟飞不高

greview 发表于 2021-9-19 10:32
请你帮忙给我看看 这个检查表的汇总和大神写的程序 要实现的目的一样 ，能不能帮我修改成我需要的，检查 ...

作业检查记录.rar (26.37 KB, 下载次数: 9)

2021-9-19 13:41 上传

点击文件名下载附件

参考！！

Colz

字典+数组
应该比较容易理解

Sub test()
'将非汇总表里的数据全部存入字典
Set dic = CreateObject("scripting.dictionary")
For Each sh In Sheets
With sh
If .Name <> "总表" Then
r = .[b65535].End(3).Row '获取使用行
c_n = .[iv2].End(1).Address
c = .[iv2].End(1).Column
.Range("D2:" & c_n).Replace "V", "Z"
For i = 4 To r - 1
'判断是否合并单元格，获取第i行，第2列的值)
r_name = IIf(.Cells(i, 2).MergeCells, .Cells(i, 2).MergeArea.Cells(1, 1), .Cells(i, 2))
For j = 4 To c - 1
c_name = IIf(.Cells(2, j).MergeCells, .Cells(2, j).MergeArea.Cells(1, 1), .Cells(2, j))
'字典名
dic_key = r_name & .Cells(i, 3) & c_name & .Cells(3, j)
'汇总
dic(dic_key) = dic(dic_key) + .Cells(i, j)
Next
Next
.Range("D2:" & c_n).Replace "Z", "V"
End If
End With
Next

'处理汇总表，定义一个数组，来取出字典内的值
With Sheets("总表")
r = .[c65535].End(3).Row
c = .[iv3].End(1).Column
ReDim arr(1 To r - 3, 1 To c - 3)
For i = 1 To r - 3
r_name = IIf(.Cells(i + 3, 2).MergeCells, .Cells(i + 3, 2).MergeArea.Cells(1, 1), .Cells(i + 3, 2))
For j = 1 To c - 3
c_name = IIf(.Cells(2, j + 3).MergeCells, .Cells(2, j + 3).MergeArea.Cells(1, 1), .Cells(2, j + 3))
dic_key = r_name & .Cells(i + 3, 3) & c_name & .Cells(3, j + 3)
arr(i, j) = IIf(Len(dic(dic_key)), dic(dic_key), 0)
Next
Next
.[d4].Resize(r - 3, c - 3) = arr
End With
Set dic = Nothing
End Sub

Colz

字典+数组  交作业

Sub test()
'将非汇总表里的数据全部存入字典
Set dic = CreateObject("scripting.dictionary")
For Each sh In Sheets
With sh
If .Name <> "总表" Then
r = .[b65535].End(3).Row '获取使用行
c_n = .[iv2].End(1).Address
c = .[iv2].End(1).Column
.Range("D2:" & c_n).Replace "V", "Z"
For i = 4 To r - 1

'判断是否合并单元格，获取第i行，第2列的值)
r_name = IIf(.Cells(i, 2).MergeCells, .Cells(i, 2).MergeArea.Cells(1, 1), .Cells(i, 2))
For j = 4 To c - 1
c_name = IIf(.Cells(2, j).MergeCells, .Cells(2, j).MergeArea.Cells(1, 1), .Cells(2, j))
'字典名
dic_key = r_name & .Cells(i, 3) & c_name & .Cells(3, j)
'汇总
dic(dic_key) = dic(dic_key) + .Cells(i, j)
Next
Next
.Range("D2:" & c_n).Replace "Z", "V"
End If
End With
Next

'处理汇总表，定义一个数组，来取出字典内的值
With Sheets("总表")
r = .[c65535].End(3).Row
c = .[iv3].End(1).Column
ReDim arr(1 To r - 3, 1 To c - 3)
For i = 1 To r - 3
r_name = IIf(.Cells(i + 3, 2).MergeCells, .Cells(i + 3, 2).MergeArea.Cells(1, 1), .Cells(i + 3, 2))
For j = 1 To c - 3
c_name = IIf(.Cells(2, j + 3).MergeCells, .Cells(2, j + 3).MergeArea.Cells(1, 1), .Cells(2, j + 3))
dic_key = r_name & .Cells(i + 3, 3) & c_name & .Cells(3, j + 3)
arr(i, j) = IIf(Len(dic(dic_key)), dic(dic_key), 0)
Next
Next
.[d4].Resize(r - 3, c - 3) = arr
End With
Set dic = Nothing
End Sub

gwjkkkkk

认真学习一下。。。