基于列表隐藏工作表

• sList将是格式为 /Sheet12/Sheet2/Sheet3/ 的字符串
• InStr用于与 进行比较，并且需要 用于防止不匹配。ws.namesListMARKER

例如：ws.Name = "Sheet1"

• InStr(1, sList, ws.Name, vbTextCompare)返回值 1 - 它与Sheet12
• InStr(1, sList, MARKER & ws.Name & MARKER, vbTextCompare)返回 0 - 不在/Sheet1/sList

Option Explicit

Sub HiddenSheet()
    Dim ws As Worksheet
    Dim rngList As Range, sList As String
    Const MARKER = "/"
    Const SheetName = "Sheet1" ' Modify as needed
    With Sheets(SheetName)
        Set rngList = .Range("Visible")
        ' Optional: Show at least one sheet before hidden sheets
        'Sheets(rngList.Cells(1).Value).Visible = xlSheetVisible
        sList = MARKER & Join(Application.Transpose(.Value), MARKER) & MARKER
    End With
    For Each ws In Worksheets
        If InStr(1, sList, MARKER & ws.Name & MARKER, vbTextCompare) = 0 Then
            ws.Visible = xlSheetHidden
        End If
    Next ws
End Sub

隐藏/显示不在列表中的工作表

Sub HideShowSheets()
    Const PROC_TITLE As String = "Hide/Show Sheets"
    On Error GoTo ClearError
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Return the values from the single-column list
    ' in a 2D one-based single-column array ('Data').
    
    Dim ws As Worksheet: Set ws = wb.Sheets("Visible")
    
    Dim Data() As Variant, rCount As Long
    
    With ws.Range("A2")
        rCount = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - .Row + 1
        Select Case rCount
            Case Is < 1:
                MsgBox "The list is empty!", vbExclamation, PROC_TITLE
                Exit Sub
            Case 1: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
            Case Else: Data = .Resize(rCount).Value
        End Select
    End With
            
    ' Return the unique values from the array in the keys
    ' of a dictionary ('dict'), excluding errors and blanks.
            
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long, rValue As Variant
    
    For r = 1 To rCount
        rValue = Data(r, 1)
        If Not IsError(rValue) Then
            If Len(rValue) > 0 Then dict(rValue) = Empty
        End If
    Next r
    
    If dict.Count = 0 Then
        MsgBox "The list has no names!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Loop through the sheets in the workbook and toggle the visibility
    ' of the sheets whose names are not on the list,
    ' applying the following logic:
    '  - if the sheet is visible, hide it.
    '  - if the sheet is not visible, unhide it.
    
    Dim sh As Object ' sheets = worksheets + charts
    
    For Each sh In wb.Sheets
        If Not dict.Exists(sh.Name) Then ' not in the list
            If sh.Visible = xlSheetVisible Then ' is visible
                sh.Visible = xlSheetHidden ' xlSheetVeryHidden
            Else ' is not visible
                ' If you remove the following line,
                ' the sheets will never become visible.
                sh.Visible = xlSheetVisible
            End If
        'Else ' is on the list; do nothing
        End If
    Next sh
    
    ' Inform.
    
    MsgBox "The sheets' visibility was toggled.", vbInformation, PROC_TITLE
    
ProcExit:
    Exit Sub
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub