新人求助，怎么根据行求和

数据源

代码：
Sub 结果()
Dim 会计主体 As String, 项目名称 As String, 查询日期 As String, 查询内容 As String, str1 As String
项目名称 = Sheet1.Range("c3")
查询日期 = Sheet1.Range("c4")
str1 = Sheet1.Range("c1")
Sheets("查询报表").Range("a7:z1000").ClearContents
查询内容 = 会计主体 & 项目名称 & 查询日期 & str1
arr1 = Sheet2.Range("b2").Resize(Sheet2.Range(Sheet2.Range("b2"), Sheet2.Range("b2").End(xlDown)).Rows.Count, _
Sheet2.Range(Sheet2.Range("b2"), Sheet2.Range("b2").End(xlToRight)).Columns.Count)
If 查询内容 = "" Then Exit Sub
Dim 结果表()
总条目数 = 0
On Error Resume Next
For i = 1 To UBound(arr1, 1)
If (会计主体 = "" Or arr1(i, 1) Like "*" & 会计主体 & "*") And (项目名称 = "" Or arr1(i, 3) Like "*" & 项目名称 & "*") And (str1 = "" Or arr1(i, 4) Like "*" & str1 & "*") Then
总条目数 = 总条目数 + 1
ReDim Preserve 结果表(1 To 18, 1 To 总条目数)
结果表(1, 总条目数) = arr1(i, 1)
结果表(2, 总条目数) = arr1(i, 4)
结果表(3, 总条目数) = arr1(i, 3)
核算类型 = arr1(i, 4)
For j = 1 To UBound(arr1, 2)
If arr1(1, j) = 查询日期 Then
计划金额 = "": 计划单价 = "": 预算跟进金额 = ""
实际单价 = "": 实际数量 = "": 实际金额 = ""
预算跟进数量 = "": 预算跟进金额 = "": 预算跟进单价 = ""
If 核算类型 = "金额式" Then
计划金额 = arr1(i, j + 12)
实际金额 = arr1(i, j + 36)
预算跟进金额 = arr1(i, 6)
Else
计划数量 = arr1(i, j)
计划金额 = arr1(i, j + 12)
计划单价 = 计划金额 / 计划数量
实际数量 = arr1(i, j + 24)
实际金额 = arr1(i, j + 36)
实际单价 = 实际金额 / 实际数量
预算跟进数量 = arr1(i, 5)
预算跟进金额 = arr1(i, 6)
预算跟进单价 = 预算跟进金额 / 预算跟进数量
End If
Exit For
End If
Next j
On Error Resume Next
结果表(10, 总条目数) = 预算跟进数量
结果表(11, 总条目数) = 预算跟进单价
结果表(12, 总条目数) = 预算跟进金额
结果表(13, 总条目数) = 计划数量
结果表(14, 总条目数) = 计划单价
结果表(15, 总条目数) = 计划金额
结果表(16, 总条目数) = 实际数量
结果表(17, 总条目数) = 实际单价
结果表(18, 总条目数) = 实际金额
End If
Next i
With Sheet1.Range("b7")
.Resize(1000, 18).ClearContents
.Resize(总条目数, 18) = WorksheetFunction.Transpose(结果表)
End With
End Sub

需要在下图中查
询1-12月累计数，不论我选择的几月下图中所显示的数据均为1-12月累计数

求大佬帮帮嘛