Dim Filter As String
Dim t1, t2, t3, t4, t5 As String
Dim tb As Table = Tables("流水账")
Dim dr As DataRow
Dim st As Date
If e.Node.Text <> "显示所有行" Then
DataTables ("汇总表").DataRows.Clear
Select Case e.Node.Level
Case 0
t1 = e.Node.Text
With DataTables ("汇总表")
.StopRedraw '静止绘制
For Each DR In DataTables("流水账").DataRows
If DR("科目表_一级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("科目表_一级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("科目表_借方")
dr2("贷方") = dr("科目表_贷方")
End if
If DR("对方科目_一级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("对方科目_一级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("对方科目_借方")
dr2("贷方") = dr("对方科目_贷方")
End If
Next
.ResumeRedraw
End With
Case 1
t1 = e.Node.Text
t2 = e.Node.ParentNode.Text
With DataTables ("汇总表")
.StopRedraw '静止绘制
For Each DR In DataTables("流水账").DataRows
If DR("科目表_一级") = t2 And DR("科目表_二级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("科目表_一级")
dr2("二级科目") = dr("科目表_二级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("科目表_借方")
dr2("贷方") = dr("科目表_贷方")
End if
If DR("对方科目_一级") = t2 And DR("对方科目_二级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("对方科目_一级")
dr2("二级科目") = dr("对方科目_二级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("对方科目_借方")
dr2("贷方") = dr("对方科目_贷方")
End If
Next
.ResumeRedraw
End With
Case 2
t1 = e.Node.Text
t2 = e.Node.ParentNode.Text
t3 = e.Node.ParentNode.ParentNode.Text
With DataTables ("汇总表")
.StopRedraw '静止绘制
For Each DR In DataTables("流水账").DataRows
If DR("科目表_一级") = t3 And DR("科目表_二级") = t2 And DR("科目表_三级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("科目表_一级")
dr2("二级科目") = dr("科目表_二级")
dr2("三级科目") = dr("科目表_三级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("科目表_借方")
dr2("贷方") = dr("科目表_贷方")
End if
If DR("对方科目_一级") = t3 And DR("对方科目_二级") = t2 And DR("对方科目_三级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("对方科目_一级")
dr2("二级科目") = dr("对方科目_二级")
dr2("三级科目") = dr("对方科目_三级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("对方科目_借方")
dr2("贷方") = dr("对方科目_贷方")
End If
Next
.ResumeRedraw
End With
Case 3
t1 = e.Node.Text
t2 = e.Node.ParentNode.Text
t3 = e.Node.ParentNode.ParentNode.Text
t4 = e.Node.ParentNode.ParentNode.ParentNode.Text
With DataTables ("汇总表")
.StopRedraw '静止绘制
For Each DR In DataTables("流水账").DataRows
If DR("科目表_一级") = t4 And DR("科目表_二级") = t3 And DR("科目表_三级") = t2 And DR("科目表_四级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("科目表_一级")
dr2("二级科目") = dr("科目表_二级")
dr2("三级科目") = dr("科目表_三级")
dr2("四级科目") = dr("科目表_四级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("科目表_借方")
dr2("贷方") = dr("科目表_贷方")
End if
If DR("对方科目_一级") = t4 And DR("对方科目_二级") = t3 And DR("对方科目_三级") = t2 And DR("对方科目_四级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("对方科目_一级")
dr2("二级科目") = dr("对方科目_二级")
dr2("三级科目") = dr("对方科目_三级")
dr2("四级科目") = dr("对方科目_四级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("对方科目_借方")
dr2("贷方") = dr("对方科目_贷方")
End If
Next
.ResumeRedraw
End With
Case 4
t1 = e.Node.Text
t2 = e.Node.ParentNode.Text
t3 = e.Node.ParentNode.ParentNode.Text
t4 = e.Node.ParentNode.ParentNode.ParentNode.Text
t5 = e.Node.ParentNode.ParentNode.ParentNode.ParentNode.Text
With DataTables ("汇总表")
.StopRedraw '静止绘制
For Each DR In DataTables("流水账").DataRows
If DR("科目表_一级") = t5 And DR("科目表_二级") = t4 And DR("科目表_三级") = t3 And DR("科目表_四级") = t2 And DR("科目表_五级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("科目表_一级")
dr2("二级科目") = dr("科目表_二级")
dr2("三级科目") = dr("科目表_三级")
dr2("四级科目") = dr("科目表_四级")
dr2("五级科目") = dr("科目表_五级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("科目表_借方")
dr2("贷方") = dr("科目表_贷方")
End if
If DR("对方科目_一级") = t5 And DR("对方科目_二级") = t4 And DR("对方科目_三级") = t3 And DR("对方科目_四级") = t2 And DR("对方科目_五级") = t1 Then
Dim dr2 As DataRow
dr2 = DataTables ("汇总表").AddNew
dr2("一级科目") = dr("对方科目_一级")
dr2("二级科目") = dr("对方科目_二级")
dr2("三级科目") = dr("对方科目_三级")
dr2("四级科目") = dr("对方科目_四级")
dr2("五级科目") = dr("对方科目_五级")
dr2("日期") = dr("日期")
dr2("摘要") = dr("摘要")
dr2("凭证号") = dr("凭证号")
dr2("借方") = dr("对方科目_借方")
dr2("贷方") = dr("对方科目_贷方")
End If
Next
.ResumeRedraw
End With
End Select
End If
'********
Dim g As SubtotalGroup '汇总模式分组
g = New Subtotalgroup'定义一个新的分组
g.GroupOn = "*" '总计分组
g.TotalOn = "借方,贷方"'对借方和贷方进行统计
g.Caption = "合计"'设置标题
With Tables("汇总表")
.StopRedraw '停止绘制
.Sort = "日期,凭证号"'指定排序列
.SubtotalGroups.Clear() '清除原有的分组
.SubtotalGroups.Add(g) '加入刚刚定义的分组
.Subtotal() '生成汇总模式
.ResumeRedraw '恢复绘制
.Save ‘只有1.2万行数据,这里保存时间达到5.5秒,有什么好的办法时间缩短
End With
[此贴子已经被作者于2022/6/26 21:09:26编辑过]