excel 基于列表隐藏图纸

zengzsys  于 2023-11-20  发布在  其他
关注(0)|答案(2)|浏览(169)

我是新来的工作表(Visual Basic for Applications)&我正在编写一个代码,旨在隐藏基于预定义列表的特定工作表。本质上,我想隐藏任何工作表的名称不存在于此列表中。(列表中的名称等于工作表中的名称)
我已经写了一些代码,但我不确定如何实现我想要的结果。我想做的是将“Visible”的使用替换为对名为“Visible”的工作表中单元格列表的引用。
我需要将“Visible”替换为一个名为Visible的单元格列表。当代码执行时,它应该隐藏任何名称不在此列表中的工作表。

Sub ocultarPlanilhas()
 Dim ws As Worksheet
 Sheets().Select

 For Each ws In Worksheets
   If ws.Name <> "Visible" Then
   ws.Visible = xlSheetHidden
  End If
 Next ws
End Sub

字符串
有人能帮帮我吗

oo7oh9g9

oo7oh9g91#

  • sList将是格式为/Sheet 12/Sheet 2/Sheet 3/的字符串。
  • 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

字符串

ee7vknir

ee7vknir2#

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

x1c 0d1x的数据

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

字符串

相关问题