ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何按特定格式汇总银行存贷数据库数据,并加以明细提醒?

如何按特定格式汇总银行存贷数据库数据,并加以明细提醒?

作者:绿色风 分类: 时间:2022-08-17 浏览:145
楼主
liuguansky
Q;如何把存贷款的明细数据库资料,按机构号、行政公司性质、本外币种进行分类汇总,调整为汇总表的格式式样,同时对汇总表没有的明细机构进行提示?
A:用如下代码可以实现:
  1. Sub test()
  2. Dim dic, arr, i&, j&, arrt() As Long, s&, str1$
  3. Set dic = CreateObject("scripting.dictionary")
  4. arr = [a4:a20]
  5. For i = 1 To UBound(arr, 1)
  6. dic(arr(i, 1)) = i
  7. Next i
  8. ReDim arrt(1 To UBound(arr, 1) + 1, 1 To 24)
  9. dic.Add "公司本币", 1
  10. dic.Add "公司外币", 7
  11. dic.Add "行政本币", 13
  12. dic.Add "行政外币", 19
  13. With Sheet3
  14. arr = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(3).Row, 25)
  15. End With
  16. For i = 2 To UBound(arr, 1)
  17. If dic.exists(arr(i, 2)) Then
  18. s = dic(arr(i, 11) & arr(i, 13))
  19. For j = 0 To 11 Step 2
  20. arrt(dic(arr(i, 2)), s + j / 2) = arrt(dic(arr(i, 2)), s + j / 2) + arr(i, 14 + j)
  21. Next j
  22. Else: str1 = str1 & "," & arr(i, 2)
  23. End If
  24. Next i
  25. For i = 1 To 24
  26. arrt(UBound(arrt, 1), i) = Application.Sum(Application.Index(arrt, 0, i))
  27. Next i
  28. With Cells(4, 2).Resize(UBound(arrt), 24)
  29. .ClearContents
  30. .Value = arrt
  31. End With
  32. MsgBox "汇总成功" & IIf(str1 = "", ",所有机构均已统计", ",但有以下机构未在汇总表中统计:" _
  33. & vbCrLf & vbTab & Mid(str1, 2))
  34. Set dic = Nothing
  35. End Sub
2楼
kevinchengcw
进来学习一下花老怪的帖子

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap