|
|
Sub 插入合计行()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheet1
ar = .[a1].CurrentRegion
End With
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
If IsDate(ar(i, 1)) Then
nf = Year(ar(i, 1))
If d(nf) = "" Then
d(nf) = i
Else
d(nf) = d(nf) & "|" & i
End If
End If
End If
Next i
With Sheets("结果")
.[a1].CurrentRegion.Offset(1) = Empty
For Each k In d.keys
dc.RemoveAll
jfje2 = 0: dfje2 = 0 '''本年合计
rr = Split(d(k), "|")
For i = 0 To UBound(rr)
xh = rr(i)
yf = Month(ar(xh, 1))
If dc(yf) = "" Then
dc(yf) = xh
Else
dc(yf) = dc(yf) & "|" & xh
End If
jfje2 = jfje2 + ar(xh, 5)
dfje2 = dfje2 + ar(xh, 6) ''本年合计
jfqb = jfqb + ar(xh, 5)
dfqb = dfqb + ar(xh, 6) '''全部合计
Next i
For Each kc In dc.keys
jfje1 = 0: dfje1 = 0 '''本月合计
n = 0
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
rr = Split(dc(kc), "|")
For i = 0 To UBound(rr)
xh = rr(i)
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(xh, j)
Next j
jfje1 = jfje1 + ar(xh, 5)
dfje1 = dfje1 + ar(xh, 6)
Next i
r = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(r, 1).Resize(n, UBound(br, 2)) = br
.Cells(r + n, 1) = "本月合计："
.Cells(r + n, 5) = jfje1
.Cells(r + n, 6) = dfje1
.Cells(r + n + 1, 1) = "本年合计："
.Cells(r + n + 1, 5) = jfje2
.Cells(r + n + 1, 6) = dfje2
.Cells(r + n + 2, 1) = "全部合计："
.Cells(r + n + 2, 5) = jfqb
.Cells(r + n + 2, 6) = dfqb
Next kc
Next k
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-3-14 08:42
