合计B至F列相同对应M、N列数值

zhurq9876 · 发表于 2022-12-7 01:54

liulang0808 · 发表于 2022-12-7 07:56

https://club.excelhome.net/threa ... tml?_dsign=b73ad3d6
字典案例供参考。。。。

liulang0808 · 发表于 2022-12-7 08:18

Sub test()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Sheets("汇总表").UsedRange.Offset(1, 11).ClearContents
arr = Sheets("汇总表").UsedRange
For j = 2 To UBound(arr)
      str1 = ""
      For i = 2 To 5
         str1 = str1 & "##" & arr(j, i)
      Next i
      d(str1) = j
Next j
brr = Sheets("基础数据").UsedRange
For j = 2 To UBound(brr)
      str1 = ""
      For i = 2 To 5
         str1 = str1 & "##" & brr(j, i)
      Next i
      If d.exists(str1) Then
         r = d(str1)
         arr(r, 12) = arr(r, 12) + brr(j, 12)
         arr(r, 13) = arr(r, 13) + brr(j, 13)
         arr(r, 14) = arr(r, 14) + brr(j, 14)
      End If
Next j
Sheets("汇总表").UsedRange = arr
Application.ScreenUpdating = True
End Sub

liulang0808 · 发表于 2022-12-7 08:19

本帖最后由 liulang0808 于 2022-12-7 08:22 编辑

根据B-E列相同做了合计，跟楼主需求有出入

zhurq9876 · 发表于 2022-12-7 08:21

liulang0808 发表于 2022-12-7 08:19
根据B-E列相同做了合计，跟楼主需求有出入

对，附件中是B-E列相同,合计M列，且为多工作表。想要修改成单工作表，多列数值分别合计

liulang0808 · 发表于 2022-12-7 08:22

zhurq9876 发表于 2022-12-7 08:21
对，附件中是B-E列相同,合计M列，且为多工作表。想要修改成单工作表，多列数值分别合计

4楼重新添加了附件，供参考吧

zhurq9876 · 发表于 2022-12-7 08:27

liulang0808 发表于 2022-12-7 08:22
4楼重新添加了附件，供参考吧

感谢。我没有描述清楚，汇总表中B-E列是空白的。基础数据有这边才填入数据

3190496160 · 发表于 2022-12-7 10:29

Sub 分类汇总()
Dim ar As Variant
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("基础数据")
r = .Cells(.Rows.Count, 2).End(xlUp).Row
ar = .Range("a1:n" & r)
End With
ReDim br(1 To UBound(ar), 1 To 14)
For i = 2 To UBound(ar)
If Trim(ar(i, 2)) <> "" Then
      zf = Trim(ar(i, 2)) & "|" & Trim(ar(i, 3)) & "|" & Trim(ar(i, 4)) & "|" & Trim(ar(i, 5))
      t = d(zf)
      If t = "" Then
         k = k + 1
         d(zf) = k
         t = k
         br(k, 1) = k
         For j = 2 To 5
            br(k, j) = ar(i, j)
         Next j
      End If
      For j = 12 To 14
         br(t, j) = br(t, j) + ar(i, j)
      Next j
End If
Next i
With Worksheets("汇总表")
.UsedRange.Offset(1).Clear
.Range("a2").Resize(k, UBound(br, 2)) = br
.Range("a2").Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160 · 发表于 2022-12-7 10:30

材料1.rar (150.93 KB, 下载次数: 4)

3190496160 · 发表于 2022-12-7 10:31

使用excel表格的习惯太差了，整个页面都设置了边框线，会拖慢代码运行的速度的，

		自动登录	找回密码
密码			免费注册

[求助] 合计B至F列相同对应M、N列数值

评分