使用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

本节演示案例：

1. 利用Set创建表并命名
2. 利用Dir函数确认某文件是否存在
3. Dir函数返回某文件夹中的所有文件名
4. 多文件合并-每个文件中一张表
5. 多文件合并-每个文件中若干张表
6. 使用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