VBA应用

02 工作簿

收集多个工作簿内的工作表名

收到了N个部门提交上来的工作簿，按照要求里面都必须要包含某几个工作表，如何快速检查？

介绍一个快速收集工作簿的每个工作表的方法！

结果如图所示：

运行视频：

源码下载：

描述：

快速收集多个指定工作簿内的工作表名称

VBA实现过程：

1.FileToOpen = Application.GetOpenFilename(),弹出一个交互窗口，返回用户选择的工作簿的绝对路径；
2.两个循环嵌套，一个是循环依次打开选择的工作簿，伴随一个写入工作簿名称的代码行，嵌套一个工作簿内的每个工作表，伴随着写入工作表名的代码行。

示例代码

复制成功!


Sub 收集多个工作簿内的工作表名()

    Dim FileToOpen As Variant
    Dim wb_count As Long
    Dim ws_count As Integer
    Dim sht As Worksheet

    '弹窗，选择需要收集的工作簿
    FileToOpen = Application.GetOpenFilename("Excel文件,*.xl*", , "请选择要收集的工作簿", , True)
    If VBA.TypeName(FileToOpen) = "Boolean" Then
        MsgBox "没有选择文件": Exit Sub
    End If

    ' 禁用屏幕更新和警告
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ws_count = 1
    For wb_count = 1 To UBound(FileToOpen)  '遍历选择的每个工作簿
         Workbooks.Open Filename:=FileToOpen(wb_count) '打开工作簿
         ThisWorkbook.Sheets(1).Cells(ws_count, 1) = ActiveWorkbook.Name '当前工作簿的第一个工作表的A列接收工作簿名称
         For Each sht In ActiveWorkbook.Sheets  '遍历工作簿内的每个工作表
            ThisWorkbook.Sheets(1).Cells(ws_count, 2) = sht.Name  'B列接收工作表名
            ws_count = ws_count + 1 '行增加1
         Next sht
         ActiveWorkbook.Close '每个工作簿收集完后，关闭它
    Next wb_count


    ' 恢复屏幕更新和警告
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "工作簿内工作表收集完成"  '过程结束告知！

End Sub