欢迎转发和点一下“在看”，文末留言互动!
置顶公众号或设为星标及时接收更新不迷路
小伙伴们好，今天来和大家分享一道VBA的题目。之前我和大家分享了一篇推文想知道如何快速提取文件夹中所有文件名吗？和学不会这个VBA小函数，你就甭想遍历文件夹下全部内容！，在那两篇帖子中我分别分享了用函数公式和代码来提取工作簿中所有文件的名称。
今天的这道题目是在以上基础上更近一步。在提取了工作簿的名称后，还要将每个工作簿中的工作表名称提取出来，放在工作簿名称后。
同样，这道问题也可以利用VBA轻松解决，并得到如下的结果。
01
VBA代码遍历工作簿和工作表
完成代码如下：
Sub text()Dim directory As String, filename As String, i As Integer, j As Integer, mysht As Worksheet= Falsedirectory = ThisWorkbook.Path & "\工作簿\"filename = Dir(directory & "*.xl??")Do While filename <> ""i = i + 1j = 21) = filename(directory & filename)For Each mysht In Workbooks(filename).Worksheetsj) = mysht.Namej = j + 1NextWorkbooks(filename).Closefilename = DirLoop= TrueEnd Sub
简单介绍一下这段代码。
Application.ScreenUpdating = False...Application.ScreenUpdating = True
将ScreenUpdating关闭，避免屏幕过于频繁地更新刷屏。过程结束后要记得将ScreenUpdating再次打开。
directory = ThisWorkbook.Path & "\工作簿\"filename = Dir(directory & "*.xl??")
命名两个变量directory和filenmae。其中filename的命名利用了DIR函数。
Do While filename <> ""i = i + 1j = 2Sheet1.Cells(i, 1) = filenameWorkbooks.Open (directory & filename)For Each mysht In Workbooks(filename).WorksheetsSheet1.Cells(i, j) = mysht.Namej = j + 1NextWorkbooks(filename).Closefilename = DirLoop
Do...loop实现了这样一个循环过程：
当找到第一个工作簿时，将其名称写入A1单元格
随后将该工作簿打开
For Each语句遍历该工作簿中每一个工作表，并在第一行的第二个单元格开始，依次录入工作表名。
完成后关闭该工作簿。
将下一个工作簿名称命名给参数filename，循环。
本期内容练习文件提取方式：
链接: https://pan.baidu.com/s/15UmmoyCZdRG4CQ4Myyn9dw?pwd=229q 提取码: 229q
-END-
长按下方二维码关注EXCEL应用之家
面对EXCEL操作问题时不再迷茫无助
我就知道你“在看”
