使用DIR函数合并多个文件的数据——Excel之VBA(10)
•将对象赋值到变量
用到Set
•将对象赋值到变量中的好处
•将单元格赋值到变量
•将工作表赋值到变量
Sub test() Dim i As Integer Dim sht As Worksheet For i = 2 To 5 Set sht = Sheets.Add sht.Name = Sheet1.Range("a" & i) Next End Sub
•将工作簿赋值到变量
•认识Dir函数
•Dir函数验证是否存在某个文件
Sub test() Dim i As Integer For i = 1 To 6 If Dir("e:\data\" & Range("a" & i) & ".xls*") = "" Then Range("b" & i) = "无" Else Range("b" & i) = " 有" End If Next End Sub
•多个条件相符的文件 Dir如何返回值
说明：值得注意的是，在多个条件相符的时候，Dir会存放所有结果，调用一次Dir返回一次
并且下一次调用时，不用写后续条件，直接=Dir
另：当结果取完，再取一次结果为空，再取一次会报错
示例：
str = Dir("e:\data\*.xls*")
str = Dir
str = Dir
•Dir函数遍历循环所有文件
Sub test() Dim str As String Dim wb As Workbook str = Dir("e:\data\*.xls*") For i = 1 To 100 ' Range("a" & i) = str '其余的都是框架，中间才是核心事件处理过程 ' - - - - - - - - - - - - 分割线 - - - - - - - - - - - - - - Set wb = Workbooks.Open("e:\data\" & str) wb.Close ' - - - - - - - - - - - - 分割线 - - - - - - - - - - - - - - str = Dir If str = "" Then Exit For End If Next End Sub
•多文件合并
•多个文件 每个文件中一张表
Sub test() Dim str As String Dim wb As Workbook str = Dir("e:\data\*.xls*") For i = 1 To 100 ' Range("a" & i) = str '其余的都是框架，中间才是核心事件处理过程 ' - - - - - - - - - - - - 分割线 - - - - - - - - - - - - - - Set wb = Workbooks.Open("e:\data\" & str) wb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '跨文件了就要带上文件 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0) wb.Close ' - - - - - - - - - - - - 分割线 - - - - - - - - - - - - - - str = Dir If str = "" Then Exit For End If Next End Sub
•多个文件 每个文件中若干张表
Sub test() Dim str As String Dim wb As Workbook Dim sht As Worksheet str = Dir("e:\data\*.xls*") For i = 1 To 100 ' Range("a" & i) = str '其余的都是框架，中间才是核心事件处理过程 ' - - - - - - - - - - - - 分割线 - - - - - - - - - - - - - - Set wb = Workbooks.Open("e:\data\" & str) For Each sht In wb.Sheets sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '跨文件了就要带上文件 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0) & sht.Name Next wb.Close ' - - - - - - - - - - - - 分割线 - - - - - - - - - - - - - - str = Dir If str = "" Then Exit For End If Next End Sub
•使用查找功能
Sub test() Dim rng As Range Set rng = Range("d:d").Find(Range("l3")) If Not rng Is Nothing Then Range("m3") = rng.Offset(0, 3) End If End Sub
作业回顾：
拆分多表--------通用项
说明：此代码可直接复制到VBA中进行拆分使用，拆分的是当前点击激活的表（即数据源），其他与拆分无关的表会被删除
Sub chaifenshuju() Dim sht As Worksheet Dim k, i, j As Integer Dim irow As Integer '这个说的是一共多少行 Dim l As Integer Dim sht0 As Worksheet Set sht0 = ActiveSheet l = InputBox("请输入你要按哪列分") '删除无意义的表 Application.DisplayAlerts = False If Sheets.Count > 1 Then For Each sht1 In Sheets 'If sht1.Name <> "数据" Then If sht1.Name <> sht0.Name Then sht1.Delete End If Next End If Application.DisplayAlerts = True irow = sht0.Range("a65536").End(xlUp).Row '拆分表 For i = 2 To irow k = 0 For Each sht In Sheets If sht.Name = sht0.Cells(i, l) Then k = 1 End If Next If k = 0 Then Sheets.Add after:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = sht0.Cells(i, l) End If Next '拷贝数据 For j = 2 To Sheets.Count sht0.Range("a1:z" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name sht0.Range("a1:z" & irow).Copy Sheets(j).Range("a1") Next sht0.Range("a1:f" & irow).AutoFilter sht0.Select MsgBox "已处理完毕，牛逼不" End Sub
本节演示案例：
- 利用Set创建表并命名
- 利用Dir函数确认某文件是否存在
- Dir函数返回某文件夹中的所有文件名
- 多文件合并-每个文件中一张表
- 多文件合并-每个文件中若干张表
- 使用FIND方法查找数据
需要理解并记住写法的概念：
SET sht = sheet1
Dir (“D:\data\*.*”)
Range(“a:a”).find（“张三”)
需要理解的概念：
附表 Dir代码
附表 Find代码
附表：Dir代码
Sub test() Dim str As String Dim wb As Workbook Dim i As Integer str = Dir("d:\data\*.*") For i = 1 To 100 Set wb = Workbooks.Open("d:\data\" & str) '这里该干什么干什么 wb.Close str = Dir If str = "" Then Exit For End If Next End Sub
附表：FIND代码
Sub test() Dim rng As Range Set rng = Range("d:d").Find(Range("l3")) If Not rng Is Nothing Then Range("m3") = rng.Offset(0, 3) End If End Sub
