[發問] 在VBA中，如何使用巨集隱藏部份工作表、及取消隱藏全部工作表？

goner

請問各位先進在VBA中，如何使用巨集隱藏部份工作表、及取消隱藏全部工作表？
假設有15個工作表，A組1.2.3工作表、B組4.5.6工作表、C組7.8.9工作表、D組10.11.12工作表、E組13.14.15
巨集1：A、B工作表不隱藏，其他C、D、E工作表隱藏。
巨集2：A、C工作表不隱藏，其他B、D、E工作表隱藏。
巨集3：A、D工作表不隱藏，其他B、C、E工作表隱藏。
巨集4：A、E工作表不隱藏，其他B、C、D工作表隱藏。

有找到隱藏/取消隱藏的VBA，但不知如何執行部份、全部
Sub UnhideSheet()
       Sheets("Sheet1").Visible = True
End Sub

Sub HideSheet()
       Sheets("Sheet1").Visible = False
End Sub

請各位先進不吝指教。謝謝。

Andy2483

回復 1# goner


    謝謝前輩發表此主題與情境
後學藉此題學習到很多知識,練習了字典.一維陣列與Select Case,學習結果請前輩試試看
輸入窗:

下載 (50.46 KB)

2022-12-20 09:57

輸入窗輸入 1 結果:

下載 (35.16 KB)

2022-12-20 09:58

輸入窗輸入 2結果:

下載 (36.03 KB)

2022-12-20 09:59

依此類推到 4
輸入 0 則為全部工作表都顯示

Option Explicit
Sub 工作表顯示隱藏控制()
Application.ScreenUpdating = False
Dim N%, i&, xR, V, Y, Z, No, G1, G2, G3
No = InputBox("請輸入 0~4 數字!", "工作表顯示隱藏控制", 0)
If No < 0 Or No > 4 Then Exit Sub
Set Y = CreateObject("Scripting.Dictionary")
V = ",工作表1,工作表2,工作表3,工作表4,工作表5,工作表6,工作表7,工作表8,工作表9,工作表10,工作表11,工作表12,工作表13,工作表14,工作表15"
V = Split(V, ",")
For Each xR In [A1:E1]
   Z = Split(xR.Address, "$")(1)
   Y(Z) = Array(V(1 + N), V(2 + N), V(3 + N))
   N = N + 3
Next
For Each xR In ActiveWorkbook.Worksheets
   xR.Visible = True
Next
If No = 0 Then GoTo 111
Select Case No
Case 1: G1 = Y("C"): G2 = Y("D"): G3 = Y("E")
Case 2: G1 = Y("B"): G2 = Y("D"): G3 = Y("E")
Case 3: G1 = Y("B"): G2 = Y("C"): G3 = Y("E")
Case 4: G1 = Y("B"): G2 = Y("C"): G3 = Y("D")
End Select
Sheets(G1).Visible = False
Sheets(G2).Visible = False
Sheets(G3).Visible = False

111
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Set Y = Nothing
Erase V
End Sub


'執行下列程式碼可取得 15個工作表名的字串
Sub 收集15個工作表名()
Dim i&, Na$
For i = 1 To 15
   Na = Na & "," & Sheets(i).Name
Next
Workbooks.Add
[A1] = "V = """ & Na & """"
End Sub
'把 15個工作表名的字串 與上方紅字置換掉

Andy2483

如果符合情境需求:
1.可以調換工作表位置
2.不可更改工作表名稱
3.工作表不可短少
4.可以增加新工作表

下載 (14.32 KB)

2022-12-20 10:39

goner

感謝Andy2483先進的解答
以上VBA程式碼基本上可以使用，有將V替換掉，輸入0、4正常運作。
V = ",工作表1,工作表2,工作表3,工作表4,工作表5,工作表6,工作表7,工作表8,工作表9,工作表10,工作表11,工作表12,工作表13,工作表14,工作表15"
配合 Sub 收集15個工作表名() 替換成
V = [A1]

但使用上輸入1、2、3皆會在這行出現錯誤 Sheets(G3).Visible = False ，錯誤提示 [陣列索引超出範圍]，
錯誤後 E組工作表 不會執行到隱藏。

下載 (11.36 KB)

2022-12-20 14:54

'執行下列程式碼可取得 15個工作表名的字串
Sub 收集15個工作表名()
Dim i&, Na$
For i = 1 To 15
   Na = Na & "," & Sheets(i).Name
Next
Workbooks.Add      <<測試時無使用新增工作表，在原活頁簿新增 [工作表1] 使用遇以上問題。
[A1] = "V = """ & Na & """"
End Sub
'把 15個工作表名的字串 與上方紅字置換掉

請問如何調整解決，謝謝。:)

准提部林

A組都不隱藏, 代碼中就不須理會

Andy2483

回復 4# goner


    執行以下程式後,把結果複製到VBA

下載 (126.28 KB)

2022-12-20 16:48

Option Explicit
Sub TEST_20221220()
Dim A(100), i&, Na$, N%
For i = 1 To 15
   Na = Na & "," & Sheets(i).Name
Next
A(N) = "Sub 工作表顯示隱藏控制()": N = N + 1
A(N) = "Application.ScreenUpdating = False": N = N + 1
A(N) = "Dim N%, i&, xR, V, Y, Z, No, G1, G2, G3": N = N + 1
A(N) = "No = InputBox(""請輸入 0~4 數字!"", ""工作表顯示隱藏控制"", 0)": N = N + 1
A(N) = "If No < 0 Or No > 4 Then Exit Sub": N = N + 1
A(N) = "Set Y = CreateObject(""Scripting.Dictionary"")": N = N + 1
A(N) = "V = """ & Na & """": N = N + 1
A(N) = "V = Split(V, "","")": N = N + 1
A(N) = "For Each xR In [A1:E1]": N = N + 1
A(N) = "   Z = Split(xR.Address, ""$"")(1)": N = N + 1
A(N) = "   Y(Z) = Array(V(1 + N), V(2 + N), V(3 + N))": N = N + 1
A(N) = "   N = N + 3": N = N + 1
A(N) = "Next": N = N + 1
A(N) = "For Each xR In ActiveWorkbook.Worksheets": N = N + 1
A(N) = "   xR.Visible = True": N = N + 1
A(N) = "Next": N = N + 1
A(N) = "If No = 0 Then GoTo 111": N = N + 1
A(N) = "Select Case No": N = N + 1
A(N) = "Case 1: G1 = Y(""C""): G2 = Y(""D""): G3 = Y(""E"")": N = N + 1
A(N) = "Case 2: G1 = Y(""B""): G2 = Y(""D""): G3 = Y(""E"")": N = N + 1
A(N) = "Case 3: G1 = Y(""B""): G2 = Y(""C""): G3 = Y(""E"")": N = N + 1
A(N) = "Case 4: G1 = Y(""B""): G2 = Y(""C""): G3 = Y(""D"")": N = N + 1
A(N) = "End Select": N = N + 1
A(N) = "Sheets(G1).Visible = False": N = N + 1
A(N) = "Sheets(G2).Visible = False": N = N + 1
A(N) = "Sheets(G3).Visible = False": N = N + 1
A(N) = "": N = N + 1
A(N) = "111": N = N + 1
A(N) = "ActiveWindow.ScrollWorkbookTabs Position:=xlFirst": N = N + 1
A(N) = "Set Y = Nothing": N = N + 1
A(N) = "Erase V": N = N + 1
A(N) = "End Sub" ': N = N + 1
Workbooks.Add
[A1].Resize(N + 1) = Application.Transpose(A())
End Sub

goner

感謝Andy的熱心幫忙以及各位的回覆，現在找到原因囉^^
檢視 [區域變數] 視窗，發現其中有個變數多了一個 "雙引號，而導致無法正確判斷工作表名稱，調整後已可正常使用功能。

1. Option Explicit
   
2. Sub 工作表顯示隱藏控制()
   
3. Application.ScreenUpdating = False
   
4. 
   
5. Dim N%, i&, xR, V, Y, Z, No, G1, G2, G3
   
6. No = InputBox("請輸入 0~4 數字!", "工作表顯示隱藏控制", 0)
   
7. 
   
8. If No < 0 Or No > 4 Then Exit Sub
   
9. 
   
10. Set Y = CreateObject("Scripting.Dictionary")
    
11. V = [A1]    ' 這裡配合巨集 收集15個工作表名() 使用，蒐集目前活頁簿所有工作表名稱。
    
12. V = Split(V, ",")
    
13. For Each xR In [A1:E1]
    
14.    Z = Split(xR.Address, "$")(1)
    
15.    Y(Z) = Array(V(1 + N), V(2 + N), V(3 + N))
    
16.    N = N + 3
    
17. Next
    
18. 
    
19. For Each xR In ActiveWorkbook.Worksheets
    
20.    xR.Visible = True
    
21. Next
    
22. 
    
23. If No = 0 Then GoTo 111:
    
24. 
    
25. Select Case No
    
26.     Case 1: G1 = Y("C"): G2 = Y("D"): G3 = Y("E")
    
27.     Case 2: G1 = Y("B"): G2 = Y("D"): G3 = Y("E")
    
28.     Case 3: G1 = Y("B"): G2 = Y("C"): G3 = Y("E")
    
29.     Case 4: G1 = Y("B"): G2 = Y("C"): G3 = Y("D")
    
30. End Select
    
31. Sheets(G1).Visible = False
    
32. Sheets(G2).Visible = False
    
33. Sheets(G3).Visible = False
    
34. 
    
35. 111:
    
36. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    
37. Set Y = Nothing
    
38. Erase V
    
39. End Sub
    
40. 
    
41. '執行下列程式碼可取得 15個工作表名的字串
    
42. Sub 收集15個工作表名()
    
43. 
    
44. Dim i&, Na$
    
45. For i = 1 To 15
    
46.    Na = Na & "," & Sheets(i).Name
    
47. Next
    
48. 'Workbooks.Add    ' 以原有活頁簿使用，所以不新增活頁簿。
    
49. [A1] = "V=""" & Na & ""    ' 這裡有做調整。原[A1] = "V = """ & Na & """"  變數會多了一個 "雙引號，而導致無法正確判斷工作表名稱。
    
50. 
    
51. End Sub
    
52. '把 15個工作表名的字串 與上方紅字置換掉

複製代碼

以下是一次 取消隱藏 所有工作表程式碼，供參考。

1. Sub UnhideAllSheets()
   
2.         Dim UAS As Worksheet
   
3. 
   
4.         For Each UAS In ActiveWorkbook.Worksheets
   
5.                 UAS.Visible = xlSheetVisible
   
6.         Next UAS
   
7. 
   
8. End Sub

複製代碼

goner

回復 6# Andy2483


第一次發問，以上發問都沒注意到要使用 [回覆] 功能， 請見諒！
再次謝謝Andy的幫忙。
:handshake

Andy2483

回復 1# goner


    謝謝前輩回復與自己練習編輯修改
今天後學再複習這帖發現許多考量不足,在學習了一次,以下是心得註解,請參考,請各位前輩們在指導其他語法,謝謝

Option Explicit
Sub 工作表顯示隱藏控制()
Application.ScreenUpdating = False
'↑螢幕暫不跟隨程序變化執行結果
Dim N%, No%, i&, V, xR, Y, G1, G2, G3
'↑宣告變數:(xR ,V, Y, G1, G2, G3)是通用型變數
'(N,No)是短整數變數,i是長整數
No = InputBox("請輸入 0~4 數字!", "工作表顯示隱藏控制", 1)
'↑令No是 InputBox 函式,1是預先置入的數字
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/inputbox-function
If No < 0 Or No > 4 Then Exit Sub
'↑令如果No這短整數值不是0,1,2,3,4之一!,就結束程式執行
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y是 字典
V = Sheets(1).[A1]
'↑令V這通用型變數是 第一個工作表[A1]儲存格值
V = Split(V, ",")
'↑令V這通用型變數變為 將自己被","符號分割的一維陣列
For Each xR In [{"A","B","C","D","E"}]
'↑設順迴圈!令xR這通用型變數是 一維陣列裡的一個值,從前面輪到最後
   Y(xR) = Array(V(1 + N), V(2 + N), V(3 + N))
   '↑令xR迴圈值是key,Item是一維陣列,裡面有3個值,
   'N是短整數,初始值是0,所以一開始的3個值是[A1]儲存格值被分割後的索引號1,2,3個陣列值
   N = N + 3
   '↑令N累加 3
Next
For Each xR In ActiveWorkbook.Worksheets
'↑設順迴圈!令xR這通用型變數變為此工作中活頁部的工作表之一,從前面輪到最後
   xR.Visible = True
   '↑令xR迴圈工作表顯示
Next
If No = 0 Then GoTo 111
'↑如果No這短整數值是 0,就跳到 111的位置繼續執行
Select Case No
'↑使用 Select Case 陳述式,隨著No這短整數值對照此陳述式內容
'https://learn.microsoft.com/zh-tw/office/vba/language/concepts/getting-started/using-select-case-statements
Case 1: G1 = Y("C"): G2 = Y("D"): G3 = Y("E")
'↑如果No這短整數值是 1,就令G1這通用型變數是 以"C"字元查字典的到的一維陣列,
'G2這通用型變數是 以"D"字元查字典的到的一維陣列,
'G3這通用型變數是 以"E"字元查字典的到的一維陣列
Case 2: G1 = Y("B"): G2 = Y("D"): G3 = Y("E")
'↑類推
Case 3: G1 = Y("B"): G2 = Y("C"): G3 = Y("E")
'↑類推
Case 4: G1 = Y("B"): G2 = Y("C"): G3 = Y("D")
'↑類推
End Select
Sheets(G1).Visible = False
'↑令G1這通用型變數所帶的陣列名工作表隱藏
Sheets(G2).Visible = False
'↑類推
Sheets(G3).Visible = False
'↑類推

111
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
'↑工作表索引標籤移到最前方
Application.Goto Sheets(1).[A1]
'↑儲存格游標跳到第一個工作表[A1]
Set Y = Nothing
Erase V
'↑釋放變數
End Sub

Sub UnhideAllSheets()
Dim UAS As Worksheet
For Each UAS In ActiveWorkbook.Worksheets
   UAS.Visible = xlSheetVisible
Next UAS
End Sub

'執行下列程式碼可取得 15個工作表名的字串
Sub 收集15個工作表名()
Dim i&, Na$
For i = 1 To 15
   Na = Na & "," & Sheets(i).Name
Next
'Workbooks.Add
Sheets(1).[A1] = Na
'第一個工作表[A1]帶入 15個工作表名的字串
End Sub
'把 15個工作表名的字串 與上方紅字置換掉

goner

回復 9# Andy2483


    謝謝還這麼用心、詳細的註解，還有附加連結網站說明，感謝。
    此讓學生學習了很多，更清楚的了解用法。