求助

share20018

明细帐运行时,下面多出几行,并有结存,那位高手能帮忙看下!

xyzxyz07

Private Sub CommandButton2_Click()
Dim x As Double, y As Double, z As Double, rng, i%, j%, k%, m%, s%, arr(1 To 1000, 1 To 26)
[a9:aa65536] = ""
x = [x8]
y = [z8]
z = [aa8]
rng = Sheet2.Range("a2:z" & Sheet2.[a65536].End(xlUp).Row)
For i = 1 To UBound(rng)
If IsError(rng(i, 1)) Then GoTo a
If rng(i, 1) = [d4] Then
m = m + 1
For j = 1 To 22
arr(m, j) = rng(i, 3 + j)
Next j
arr(m, 24) = x + arr(m, 6) - arr(m, 8) - arr(m, 9) - arr(m, 10) - arr(m, 12) - arr(m, 15): x = arr(m, 24)
arr(m, 25) = y + arr(m, 5) - arr(m, 7) - arr(m, 13): y = arr(m, 25)
arr(m, 26) = z + arr(m, 6) - arr(m, 8) - arr(m, 14) - arr(m, 15): z = arr(m, 26)
End If
a:
Next i
[b9].Resize(m, 24) = arr
[b9].Resize(m, 25) = arr
[b9].Resize(m, 26) = arr
k = 9: s = 9
Do
If Cells(k, 2) <> Cells(k + 1, 2) Then
Rows(k + 1 & ":" & k + 2).Insert
Cells(k + 1, 5) = "本月合计"
Union(Cells(k + 1, 6), Cells(k + 1, 7), Cells(k + 1, 8), Cells(k + 1, 9), Cells(k + 1, 10), Cells(k + 1, 11), Cells(k + 1, 12), Cells(k + 1, 13), Cells(k + 1, 14), Cells(k + 1, 15), Cells(k + 1, 16), Cells(k + 1, 17), Cells(k + 1, 18), Cells(k + 1, 19), Cells(k + 1, 20), Cells(k + 1, 21), Cells(k + 1, 22), Cells(k + 1, 23)) = "=sum(r" & s & "c:r[-1]c)"
Cells(k + 2, 5) = "本年累计"
Union(Cells(k + 2, 6), Cells(k + 2, 7), Cells(k + 2, 8), Cells(k + 2, 9), Cells(k + 2, 10), Cells(k + 2, 11), Cells(k + 2, 12), Cells(k + 2, 13), Cells(k + 2, 14), Cells(k + 2, 15), Cells(k + 2, 16), Cells(k + 2, 17), Cells(k + 2, 18), Cells(k + 2, 19), Cells(k + 2, 20), Cells(k + 2, 21), Cells(k + 2, 22), Cells(k + 2, 23)) = "=sumif(r9c5:r[-1]c5, ""本月合计"",r9c:r[-1]c)"
k = k + 2: s = k + 1
End If
k = k + 1
Loop Until Cells(k, 2) = ""
End Sub