EXCEL通过VBA字典的方式将各个分表的数据经过计算后显示在总表中

news/2024/4/25 19:36:37

EXCEL通过VBA字典的方式将各个分表的数据经过计算后显示在总表中

Sub 按钮1_Click()
Dim wba As Workbook
Dim shta As Worksheet
Dim ak(1 To 2000) As String
i = 1
Dim fil As Stringfil = Dir(ThisWorkbook.Path & "\*.xls*")Do While fil <> ""ak(i) = fili = i + 1fil = DirLoopSet wba = ThisWorkbook
Set shta = wba.Worksheets(1)
shta.Range("A2:A3000").ClearContents
shta.Range("C2:A3000").ClearContents
shta.Range("D2:A3000").ClearContentsi = 0
j = 2
For Each file In aki = i + 1If Trim(file) <> "程序文件.xlsm" And Trim(file) <> "~$程序文件.xlsm" And Trim(file) <> "" Thenstr1 = Split(file, ".")sname = str1(0)shta.Cells(j, 1) = snameshta.Cells(j, 1).Select'Selection = fso.GetBaseName(file)folder_location = ThisWorkbook.Path & "\" & fileshta.Hyperlinks.Add anchor:=Selection, Address:=folder_locationWith Selection.Font.Size = 14.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.TintAndShade = 0.ThemeFont = xlThemeFontNoneEnd Withj = j + 1End If
Next
'wba.Save
End Sub
Sub 汇总()
Dim wba As Workbook
Dim shta As Worksheet
Dim wb As Workbook
Dim sht As Worksheet
Dim snum As Long
Dim ak(1 To 2000) As String
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
i = 1
Dim fil As Stringfil = Dir(ThisWorkbook.Path & "\*.xls*")Do While fil <> ""ak(i) = fili = i + 1fil = DirLoopSet wba = ThisWorkbook
Set shta = wba.Worksheets(1)For Each file In ak
Application.DisplayAlerts = False
Application.ScreenUpdating = FalseIf Trim(file) <> "" And Trim(file) <> "程序文件.xlsm" ThenSet wb = Workbooks.Open(ThisWorkbook.Path & "\" & file)Set sht = wb.Worksheets(1)snum = 0gint = 2For j = 2 To 2000If Trim(sht.Cells(j, 1)) <> "" Thensht.Cells(j, 8) = CInt(sht.Cells(j, 4)) - CInt(sht.Cells(j, 5)) - CInt(sht.Cells(j, 6))snum = sht.Cells(j, 8) + snumElseIf Trim(sht.Cells(j, 1)) = "" Thensht.Range("K2") = snumFor ji = 2 To 2000If Trim(sht.Cells(ji, 12)) <> "" And Trim(sht.Cells(ji, 13)) <> "" Then '股东姓名sht.Cells(ji, 14) = CDbl(sht.Range("K2")) * CDbl(sht.Cells(ji, 13))strname = Trim(sht.Cells(ji, 12))If dic.Exists(strname) Thendic.Item(strname) = CDbl(dic(strname)) + CDbl(sht.Cells(ji, 14).Value)Elsedic.Item(strname) = CDbl(sht.Cells(ji, 14).Value)End IfElseExit ForEnd IfNext jiExit ForEnd IfNext jwb.Savewb.CloseEnd IfApplication.DisplayAlerts = True
Application.ScreenUpdating = TrueNext
shta.Range("C2:C5000").ClearContents
shta.Range("D2:D5000").ClearContentsshta.Range("C2").Resize(dic.Count) = Application.Transpose(dic.keys)
shta.Range("D2").Resize(dic.Count) = Application.Transpose(dic.items)
End Sub

https://www.xjx100.cn/news/3280724.html

相关文章

FlinkCDC详解

1、FlinkCDC是什么 1.1 CDC是什么 CDC是Chanage Data Capture&#xff08;数据变更捕获&#xff09;的简称。其核心原理就是监测并捕获数据库的变动&#xff08;例如增删改&#xff09;&#xff0c;将这些变更按照发生顺序捕获&#xff0c;将捕获到的数据&#xff0c;写入数据…

宝塔nginx配置SpringBoot服务集群代理

宝塔nginx配置SpringBoot服务集群代理 1、需求&#xff1a; 现有一个springboot服务需要部署成集群&#xff0c;通过nginx负载均衡进行访问&#xff0c;其中这个springboot服务内置了MQTT服务、HTTP服务、TCP服务。 MQTT服务开放了1889端口 HTTP服务开放了8891端口 HTTP服务开…

[极客大挑战2019]upload

该题考点&#xff1a;后缀黑名单文件内容过滤php木马的几种书写方法 phtml可以解析php代码&#xff1b;<script language"php">eval($_POST[cmd]);</script> 犯蠢的点儿&#xff1a;利用html、php空格和php.不解析<script language"php"&…

线阵相机参数介绍---变频参数控制

变频器介绍 变频器功能的目的在于对外部输入信号进行运算处理&#xff0c;以达到理想的行频值。该功能主要是为了解决信号超行频&#xff0c;图像拉伸压缩等问题。 输入信号处理过程&#xff1a; 输入信号&#xff1a;允许出发相机信号的频率f与所要求输入信号的频率F不同 …

MySQL 学习记录 1

原文&#xff1a;https://blog.iyatt.com/?p12631 1 前言 去年年初报考 3 月的计算机二级&#xff08;C 语言&#xff09;【https://blog.iyatt.com/?p9266 】考过了&#xff0c;这次打算报考 3 月的计算机三级&#xff08;数据库&#xff09;。数据库这一块&#xff0c;很…

NPM运行保存问题解决

问题描述 我在控制台运行如下命令 npm run dev结果报出如下错误 > form-generator0.2.0 dev > vue-cli-service serveINFO Starting development server... 10% building 4/4 modules 0 active(node:4920) [DEP0111] DeprecationWarning: Access to process.binding(…

在哪些领域中最需要使用 OCR 识别技术?真实场景介绍

根据我们的项目经验总结来说&#xff0c;OCR&#xff08;光学字符识别&#xff09;技术在多个领域中扮演着至关重要的角色&#xff0c;它能够将图像中的文本内容转换为机器可读的格式&#xff0c;极大地提高了数据处理的效率和准确性。以下是一些主要领域及其对应的应用场景和用…

linux部署jenkins,支持jdk1.8

无废话&#xff0c;纯干活安装指令 本文前提条件需安装jdk8&#xff0c;安装参考&#xff1a;Linux配置jdk环境 下载资源 # 创建安装目录 mkdir -p /data/jenkins && cd /data/jenkins# 下载jenkins的war包&#xff0c;v2.346.x支持jdk1.8&#xff0c;高于这个版本的…