一、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