-- 作者:建筑人生
-- 发布时间:2022/6/26 21:08:00
-- [求助] 保存时间太长
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编辑过]
|