八、跨文件操作与Dir函数

一、对象变量&将对象赋值给变量
问题导出：自动生成多张sheet并根据单元格信息给新生成的sheet命名，以往已有解决方案，但该方案思路有点绕，且只能在最后插入，可考虑新的解决方法。

以往方案：
For i = 2 To 8
     Sheets.Add after:=Sheets(Sheets.Count)
     Sheets(Sheets.Count).Name = Sheet1.Range("a" & i)
Next

Dim sht As Worksheet     ‘定义对象变量
For i = 2 To 8
    Set sht = Sheets.Add  ‘给将对象赋值给变量
    sht.Name = Sheet1.Range("a" & i)
Next

二、理解掌握Dir函数（不打开文件合并拷贝多个文件数据到一个文件中）
（1）将data文件夹中的文件全拷贝到D:\data文件夹中，演示dir函数的作用：Range("a1") = Dir("d:\data\北京.xlsx")返回北京.xlsx，而Range("a1") = Dir("d:\data\太阳.xlsx")
　　  返回空，说明dir函数的作用是找到并返回文件名，没找到则返回空，这一功能可用来判断文件是否存在，在跨文件操作时，这一功能非常有用，因为在不手动打开文件
 　　 操作时，首先需要让程序能判断一个文件是否存在，存在才执行open语句。
（2）a. 在“DEMO-3-Dir函数”中演示，将第一列写上各文件名，写宏判断对应文件是否存在；引出问题，若某文件是xls文件，则该代码判断为无该文件。怎么办？
　　  b. 可引入通配符解决此问题，将代码中"d:\data\" & Range("a" & i) & ".xlsx"改为“"d:\data\" & Range("a" & i) & ".xls*"即可。但新问题是若有两重名xls和xlsx文件，会怎么样？
  　　c. 在D:\data文件夹中新建“重庆.xlsx”和“重庆.xls”两个文件，运行以下代码并观察结果，得出结论：用通配符的Dir语句，第一次运行得到匹配结果列表并返回第一个值；
　　　　第二次运行起只写Dir，依次返回结果列表的一个值，全返回后，再运行一次返回空，再运行一次报错。

For i = 1 To 5
  　　  If Dir("d:\data\" & Range("a" & i) & ".xlsx") <> "" Then
        Range("b" & i) = "有该文件"
    Else
         Range("b" & i) = "无该文件"
    End If
Next            步骤 a.

步骤 c.
Range("c1") = Dir("d:\data\重庆.xls*")‘该语句得到匹配结果列表并返回第一个值
Range("c2") = Dir   ‘第二次起只使用Dir，返回结果列表的第二个值
Range("c3") = Dir　　‘当结果已全部返回时，该语句返回空
Range("c4") = Dir　　‘已返回空了，再运行Dir语句，则会报错步骤b

　　d. 应用这一结论，可输出文件夹中所有文件的名字到当前文件中。演示。很厉害，但这样的操作有什么作用？观察红字部分代码，其实就这一行代码在做操作，其余部分代码均可
　　　通用到其他场景，因此可替换红字部分代码为其他操作。
　　e. 将红字部分代码替换成Workbooks.Open("d:\data\" & str)，可一次性打开所有文件，替换成其他代码，可一次性对所有文件做其他操作。但这又有什么用？
　　f. 用set wb = 语句解决对打开文件命名、调用的问题，就可用wb.close将文件关闭，这一段代码因此可作为一次性打开所有文件并操作的模板，在蓝色部分写个性化操作的代码；　　

Dim str As String
str = Dir("d:\data\*.xls*")
For i = 1 To 100
    Range("c" & i) = str
    str = Dir
    If str = "" Then
    Exit For
    End If
Next              步骤 d.

Dim str As String
str = Dir("d:\data\*.xls*")
For i = 1 To 100
Workbooks.Open("d:\data\" & str)
str = Dir
    If str = "" Then
    Exit For
    End If
Next                   步骤 e.

Dim str As String
Dim wb As Workbook
str = Dir("d:\data\*.xls*")
For i = 1 To 100  ‘这里用do while循环更好，但100一般够用了
　　Set wb = Workbooks.Open("d:\data\" & str)
　　**这里可写任何想操作的代码***
    wb.Close
    str = Dir
    If str = "" Then
    Exit For
    End If
Next                步骤 f. 此段代码可作模板使用

（3）不打开文件的情况下将多个文件（每个文件仅一张sheet）中的sheet合并拷贝到当前文件中：将下面左边的代码添加到模板中即可，可先演示录制宏。
（4）不打开文件的情况下将多个文件（每个文件有多张sheet）中的sheet合并拷贝到当前文件中，新表命名=文件名+原表名：将下右代码添加到模板中即可。

wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0)

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

（5）文件“DEMO-6-只是看看”，在原有查询系统的基础上，利用上述代码增加“导入数据”功能，这样查询系统可简化为仅一张表，文件可以做得很小。
（6）文件“DEMO-7-使用查找功能”，根据姓名查找分数，之前用vlookup函数，但find函数是最快的。宏录制试试看，代码很长，对应查找对话框的多个选项，但核心的就是cells.find()。
　　  可用“Range("m3") = Range("d:d").Find(Range("l3")).Offset(0, 3)”一句代码达到目的，但该代码的问题是若没有找到查询目标，会报错。为解决这一问题，引入变量rng将查询结果
　　  赋值给它，规避了报错问题。但其后应判断是否找到，若没找到，rng是nothing，因此形成下述代码。该代码可作为查询功能模板。

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

（7）文件“DEMO-2-上节作业：拆分多表 加载宏”，之前在一个文件中将一张sheet按某列字段拆分成多个文件，代码很长，但缺乏通用性，主要原因在于：（a）表名不能限制为“数据”，
　　  需要抓取当前活动工作表的名字 （b）引用单元格不能用Sheet1，因为数据中有可能不在sheet1表，需要改成sheets(“表名")这种样式 （c） 原来的代码只针对A-F列，未来待处
　　  理的数据可能很多列，需要开大一点，例如A-Z列。
　　  解决思路：（a）引入Dim sht0 As Worksheet，并Set sht0 = ActiveSheet，替代sheet("数据")及sheet1，突破了表名限制，将这两种名字全替换成sht0，问题解决。
（8）将替换后的代码做成加载宏，可用于文件“测试数据”。

八、跨文件操作与Dir函数

原文：https://www.cnblogs.com/y2000zhang/p/13599341.html