当前位置：首页 > news >正文

EXCEL-VB编程实现自动抓取多工作簿多工作表中的单元格数据

news 2025/9/6 4:20:00

一、VB编程基础

1、 EXCEL文件启动宏设置

文件-选项-信任中心-信任中心设置-宏设置-启用所有宏

汇总文件保存必须以宏启动工作簿格式类型进行保存

2、 VB编程界面与入门

参考收藏
https://blog.csdn.net/O_MMMM_O/article/details/107260402?spm=1001.2014.3001.5506

二、自动抓取多工作簿多工作表中的单元格数据

1、描述

在同一路径下，有5个EXCEL工作簿，每个工作簿里面有7张工作表sheet，每张sheet里面的固定单元格有同一类型数据；1个EXCEL汇总工作簿，里面有1张工作表sheet，用来汇总抓取的数据内容。
在这里插入图片描述

2、VB程序

Sub output()Application.ScreenUpdating = FalseDim Mydir As StringDim i As Integeri = 2
'获取当前工作簿所在路径'Mydir = ThisWorkbook.Path & "\"'Left(App.Path, 1)是用来返回路径中第一个字母，即盘符 如：C，D，E,chdrive则是改变当前盘'ChDrive Left(Mydir, 1)ChDir Mydir'文件名Match = Dir$("*.xlsx")DoIf Not LCase(Match) = LCase(ThisWorkbook.Name) ThenWorkbooks.Open Match, True'各工作簿的文件名放到汇总表A列ThisWorkbook.ActiveSheet.Range("A" & i) = Match'各工作簿中SHEET1的B2单元格内容放到汇总表B列ThisWorkbook.ActiveSheet.Range("B" & i) = ActiveWorkbook.Sheets("sheet1").Range("A4")'各工作簿中SHEET2的B2单元格内容放到汇总表B列'ThisWorkbook.ActiveSheet.Range("D" & i) = ActiveWorkbook.Sheets("Sheet2").Range("B2")ThisWorkbook.ActiveSheet.Range("E" & i) = ActiveWorkbook.Sheets("Sheet2").Range("C2")ActiveWorkbook.Close 0i = i + 1End IfMatch = Dir$Loop Until Len(Match) = 0Application.ScreenUpdating = True
End Sub

如果需要采集SHEET1其他单元格数据，可以继续添加代码：

ThisWorkbook.ActiveSheet.Range("F" & i) = ActiveWorkbook.Sheets("Sheet1").Range("D3")

如果需要采集SHEET2其他单元格数据，可以继续添加代码：

ThisWorkbook.ActiveSheet.Range("F" & i) = ActiveWorkbook.Sheets("Sheet2").Range("D3")

如果工作簿的工作表、单元格和目标单元格有规律，可以用循环语句解决。

3、效果

在这里插入图片描述

附录

Sub find()Application.ScreenUpdating = FalseDim Mydir As StringDim i As Integeri = 2'获取当前VBA所在Excel的路径'Mydir = ThisWorkbook.Path & "\"'Left(App.Path, 1)是用来返回路径中第一个字母，即盘符 如：C，D，E,chdrive则是改变当前盘'ChDrive Left(Mydir, 1)ChDir MydirMatch = Dir$("*.xls")DoIf Not LCase(Match) = LCase(ThisWorkbook.Name) ThenWorkbooks.Open Match, 0, 1'文件名放到汇总表A列'ThisWorkbook.ActiveSheet.Range("A" & i) = Match'各工作簿中SHEET1的B2单元格内容放到汇总表B列'ThisWorkbook.ActiveSheet.Range("B" & i) = ActiveWorkbook.Sheets("Sheet1").Range("B2")ThisWorkbook.ActiveSheet.Range("C" & i) = ActiveWorkbook.Sheets("Sheet1").Range("C2")'各工作簿中SHEET2的B2单元格内容放到汇总表B列'ThisWorkbook.ActiveSheet.Range("D" & i) = ActiveWorkbook.Sheets("Sheet2").Range("B2")ThisWorkbook.ActiveSheet.Range("E" & i) = ActiveWorkbook.Sheets("Sheet2").Range("C2")ActiveWorkbook.Close 0i = i + 1End IfMatch = Dir$Loop Until Len(Match) = 0Application.ScreenUpdating = True
End Sub