具体方法如下:
在B4输入公式 =IF(ISNUMBER(A4),COUNTIF(A$1:A4,A$3),"") 下拉复制
在C7输入公式 =IF((A6<>"")*(A7=""),SUMIF(B:B,B6,A:A),"") 下拉复制
复制B列和C列,右键,选择性粘贴,值,
选中A列,开始菜单--查找和选择--定位条件--空值, 输入=C1,按CTRL+ENTER
,最后删除B列和C列就行了
请参照附件.
温馨提示：答案为网友推荐，仅供参考
第1个回答 2013-10-22
ALT+F11 打开VBE 窗口 粘贴代码 ，然后运行此宏
Sub 自动求和()
Dim c As Range
Dim findcells As Range
Dim rng As Range
Dim arr(1 To 65536)
Dim i, j, m As Integer
Set rng = Columns(1)
sr = "参考市值"
Set findcells = FindAll(SearchRange:=rng, FindWhat:=sr, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False)
If Not findcells Is Nothing Then
For Each c In findcells
k = k + 1
arr(k) = c.Row
Next
End If
arr(k + 1) = [a65536].End(xlUp).Row + 2
For i = 1 To k
Range("a" & arr(i + 1) - 1).Font.ColorIndex = 3
Range("a" & arr(i + 1) - 1).Value = "=sum(a" & arr(i) + 1 & ":a" & arr(i + 1) - 2 & ")"
Next
End Sub
Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FoundCells = FoundCell
FirstAddr = FoundCell.Address
Do
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function本回答被提问者采纳
Sub 自动求和()
Dim c As Range
Dim findcells As Range
Dim rng As Range
Dim arr(1 To 65536)
Dim i, j, m As Integer
Set rng = Columns(1)
sr = "参考市值"
Set findcells = FindAll(SearchRange:=rng, FindWhat:=sr, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False)
If Not findcells Is Nothing Then
For Each c In findcells
k = k + 1
arr(k) = c.Row
Next
End If
arr(k + 1) = [a65536].End(xlUp).Row + 2
For i = 1 To k
Range("a" & arr(i + 1) - 1).Font.ColorIndex = 3
Range("a" & arr(i + 1) - 1).Value = "=sum(a" & arr(i) + 1 & ":a" & arr(i + 1) - 2 & ")"
Next
End Sub
Function FindAll(SearchRange As Range, FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False) As Range
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
With SearchRange
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FoundCells = FoundCell
FirstAddr = FoundCell.Address
Do
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function本回答被提问者采纳
第2个回答 2013-10-22
你要怎样使用这些求和公式 这个是主要的……
如果你想单纯把求和数据 放在它下面的空格里 你就在每一个的最下方 使用 工具栏上的自动求和 按钮 就可以了……
其他的你要再补充一下哦追问
如果你想单纯把求和数据 放在它下面的空格里 你就在每一个的最下方 使用 工具栏上的自动求和 按钮 就可以了……
其他的你要再补充一下哦追问
就是太多了，一个个来点太慢了。
追答还要说说 你想放在哪里 这些统计结果 你要知道 你知道太多了 而我什么也不知道……LOL
你的数据是怎么来的啊 开始的时候怎么没有设置 合计 哪？给自己添麻烦 说说 你要把统计结果放在那里 然后 帮你做一个VBA吧
结果放在每组数据下的空行就行了，谢谢了
追答那么给你一个示例吧 我测试过了 可以正常运行 你把你的数据拷贝到这个表中 或者把这个表中的代码拷贝到你的文档中 ……然后就可以处理了 具体见附件吧
第3个回答 2013-10-22
很多吗？不多就手算吧，多就vba追问
很多，5W多行。。
追答1907,69219，+企鹅
相似回答