如何对连续的名称所对应的数值进行汇总？

作者：绿色风分类：时间：2022-08-17 浏览：132

楼主
wcymiss

Q：如何对连续的名称所对应的数值进行汇总？汇总方式有两种，如图所示。
效果1是仅对当前连续的名称对应的数据进行汇总，汇总写在最后一个连续名称对应的C列单元格。无连续的显示为空。
效果2是：出现重复名称时，汇总该名称所有B列数据，写在当前最后一个连续名称对应的D列单元格。

A：汇总效果1公式：

=IF(A2=A3,"",IF(A2=A1,SUM(IF(1,OFFSET(B$1,MATCH(1,0/(A$1:A2<>A2)),,ROW()-MATCH(1,0/(A$1:A2<>A2))))),""))

汇总效果1代码：

Private Sub CommandButton1_Click()
Dim arr, i&, tj&, t&
Application.ScreenUpdating = False
t = Cells(Rows.Count, 1).End(xlUp).Row
Range([c2], Cells(Rows.Count, 3)).ClearContents
arr = Range([a1], Cells(t + 1, 3))
tj = arr(2, 2)
For i = 3 To t
If arr(i, 1) = arr(i + 1, 1) Then
tj = tj + arr(i, 2)
Else
If arr(i, 1) = arr(i - 1, 1) Then
arr(i, 3) = tj + arr(i, 2)
tj = 0
End If
End If
Next
Range([a1], Cells(t + 1, 3)) = arr
Application.ScreenUpdating = True
End Sub

汇总效果2公式：

=IF(OR(A2=A3,COUNTIF(A$2:A2,A2)=1),"",SUMIF(A$2:A2,A2,B$2:B2))

汇总效果2代码：

Private Sub CommandButton2_Click()
Dim arr, i&, tj&, t&, arrt()
Dim d As New Dictionary
Application.ScreenUpdating = False
t = Cells(Rows.Count, 1).End(3).Row
Range("d2:d" & Rows.Count).ClearContents
ReDim arrt(1 To t - 1, 1 To 1)
arr = Range("a1:b" & t + 1)
d(arr(2, 1)) = arr(2, 2)
For i = 3 To t
If d.Exists(arr(i, 1)) Then
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
If arr(i, 1) <> arr(i + 1, 1) Then
arrt(i - 1, 1) = d(arr(i, 1))
End If
Else
d(arr(i, 1)) = arr(i, 2)
End If
Next
Cells(2, 4).Resize(t - 1, 1) = arrt
Set d = Nothing
Application.ScreenUpdating = True
End Sub

如何对连续的名称所对应的数值进行汇总？.rar

2楼
成就滋味

学习了

3楼
后知

嗯嗯很强大操作下

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表