批量删除同文件夹下工作簿中的隐藏表格（能选择文件夹最好）

蒋智龙

求助板块大哥神助力，要求批量删除同文件夹下工作簿中的隐藏表格（能选择文件夹最好）

limonet

关键字：visible

limonet

Sub limonet()
    Dim Sht As Worksheet, FileName
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    FileName = Dir(ThisWorkbook.Path & "\*.xlsx")
    Do While FileName <> ""
        Workbooks.Open ThisWorkbook.Path & "\" & FileName
        For Each Sht In Worksheets
            If Sht.Visible = 0 Then Sheets(Sht.Name).Delete
        Next Sht
        ActiveWorkbook.Close True
        FileName = Dir
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

ykcbf1100

注意：选择文件夹时，如果是选当前文件夹，则直接点确定即可。

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.6   删除工作簿隐藏的工作表
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     With Application.FileDialog(msoFileDialogFolderPicker)
   
6.         .Title = "请选择文件夹"
   
7.         .InitialFileName = ThisWorkbook.Path & ""
   
8.         If .Show = -1 Then p = .SelectedItems(1) & ""
   
9.     End With
   
10.     On Error Resume Next
    
11.     For Each f In fso.GetFolder(p).Files
    
12.         If LCase$(f.Name) Like "*.xls*" Then
    
13.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
14.                 Set wb = Workbooks.Open(f, 0)
    
15.                 For Each sht In wb.Sheets
    
16.                     If sht.Visible = xlSheetHidden Then
    
17.                         sht.Delete
    
18.                     End If
    
19.                 Next
    
20.                 wb.Close 1
    
21.             End If
    
22.         End If
    
23.     Next f
    
24.     Application.ScreenUpdating = True
    
25.     Application.DisplayAlerts = True
    
26.     MsgBox "OK！"
    
27. End Sub

复制代码

阿白0

仅供参考！
Sub DeleteHiddenTablesInDirectory()
    Dim filePath As String
    Dim fileName As String
    Dim folderPath As String
    Dim wb As Workbook
    Dim ws As Worksheet
   
    ' 设置文件夹路径，这里需要替换为你的文件夹路径
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "请选择文件夹路径。"
        If .Show = -1 Then folderPath = .SelectedItems(1) Else Exit Sub
    End With
    ' 获取文件夹中所有的Excel文件
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    fileName = Dir(folderPath & "*.xls*")
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    ' 遍历所有文件
    Do While fileName <> ""
        ' 构建完整的文件路径
        filePath = folderPath & fileName
        
        ' 尝试打开工作簿
      '  On Error Resume Next
        Set wb = Workbooks.Open(filePath, ReadOnly:=False)
       ' On Error GoTo 0
            ' 遍历工作簿中的所有工作表
            For Each ws In wb.Worksheets
                ' 遍历工作表中的所有表格
                   Debug.Print ws.Name
               If Not ws.Visible = -1 Then
                     Debug.Print ws.Name
                     ws.Delete
                End If
            Next ws
            
            ' 保存并关闭工作簿
            wb.Save
            wb.Close
        ' 获取下一个文件名
        fileName = Dir()
    Loop
    Application.ScreenUpdating = True: Application.DisplayAlerts = True
    MsgBox "所有隐藏的表格已被删除。"
End Sub

cai2532

这个删除工作簿隐藏的工作表实例很实用。

blackttea1

学习啦，谢谢