麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 在VBA中，如何使用巨集隱藏部份工作表、及取消隱藏全部工作表？ [打印本頁]

作者: goner 時間: 2022-12-19 18:44 標題: 在VBA中，如何使用巨集隱藏部份工作表、及取消隱藏全部工作表？

請問各位先進在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 時間: 2022-12-20 10:09

本帖最後由 Andy2483 於 2022-12-20 10:23 編輯

回復 1# goner

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

輸入窗輸入 1 結果:
[attach]35624[/attach]

輸入窗輸入 2結果:
[attach]35625[/attach]

依此類推到 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 時間: 2022-12-20 10:40

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

[attach]35626[/attach]

作者: goner 時間: 2022-12-20 15:12

感謝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組工作表不會執行到隱藏。
[attach]35627[/attach]

'執行下列程式碼可取得 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個工作表名的字串與上方紅字置換掉

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

作者: 准提部林 時間: 2022-12-20 16:17

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

作者: Andy2483 時間: 2022-12-20 16:46

本帖最後由 Andy2483 於 2022-12-20 16:48 編輯

回復 4# goner

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

[attach]35631[/attach]

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 時間: 2022-12-20 16:54

本帖最後由 goner 於 2022-12-20 16:55 編輯

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

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 = [A1] ' 這裡配合巨集收集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 & "" ' 這裡有做調整。原[A1] = "V = """ & Na & """" 變數會多了一個 "雙引號，而導致無法正確判斷工作表名稱。
End Sub
'把 15個工作表名的字串與上方紅字置換掉

複製代碼

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

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

複製代碼

作者: goner 時間: 2022-12-20 17:30

回復 6# Andy2483

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

作者: Andy2483 時間: 2022-12-21 08:39

本帖最後由 Andy2483 於 2022-12-21 08:41 編輯

回復 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 時間: 2022-12-21 15:40

回復 9# Andy2483

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

作者: 准提部林 時間: 2022-12-21 20:06

本帖最後由准提部林於 2022-12-22 18:20 編輯

做個樣板//各組工作表可任意組合
傳錯檔//看下下樓

作者: goner 時間: 2022-12-22 15:48

回復 11# 准提部林

版主大大，附加檔應該是主題為 [符合多條件帶出相關資訊] 的解答唷。

後學看了內部公式有包含特定文字的條件篩選公式很好用，已收藏。謝謝囉。

作者: 准提部林 時間: 2022-12-22 18:19

回復 12# goner

上錯檔了//
[attach]35646[/attach]

作者: Emily 時間: 2022-12-22 19:50

回復 9# Andy2483

個人認為用一些有意思的 label 代替 111 比較好
如 Skip, NoGroupSelection
即是
Goto Skip
.
.
Skip:

作者: Andy2483 時間: 2022-12-23 09:32

回復 14# Emily

謝謝前輩
111跟後學很久了,厚臉皮第1,錯誤最多第1,問題最多第1,請不要嫌棄他
謝謝前輩提醒後學學習多點樂趣,也可以更醒目找到目標
後學用這帖歡迎前輩,請前輩多多指教
http://forum.twbts.com/thread-23851-1-1.html
Hi

作者: Andy2483 時間: 2022-12-23 10:55

本帖最後由 Andy2483 於 2022-12-23 11:09 編輯

回復 13# 准提部林

謝謝前輩指導
後學在此範例學習到很多知識,範例心得註解如下,請前輩再指導,謝謝

Sub TEST_A1()
Dim S(5), Nx, SS$, Sht As Worksheet, Y As Boolean
'↑宣告變數:S是一維陣列S(0)~S(5),Nx是通用型變數,Sht是工作表變數,SS是字串變數
'Y是布林變數
Nx = InputBox("請輸入 0~4 數字!", "工作表顯示隱藏控制", 0)
'↑令Nx這通用型變數是InputBox() 函式回傳值
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/inputbox-function
If InStr("/1/2/3/4/0/", Nx) < 2 Then Exit Sub
'↑如果Nx通用型變數值用 InStr()函式回傳值<2 ,就結束程式執行
S(0) = "/總表/表1/表2/表3/"
'↑令S陣列索引號0的字串是雙引號包夾的文字符號
S(1) = "/Sheet4/Sheet5/Sheet6/"
'↑類推
S(2) = "/Sheet7/Sheet8/"
'↑類推
S(3) = "/Sheet9/Sheet10/Sheet11/Sheet12/"
'↑類推
S(4) = "/Sheet13/Sheet14/Sheet15/"
'↑類推
SS = S(0) & S(Nx):
'↑令SS這字串變數是索引號0的S陣列值連接索引號是 Nx變數的S陣列值
'如果想新增加工作表都是要顯示的,就在S(0)裡照規則添加
'如果想新增加工作表隨需求群組顯示/隱藏的,就在S(1)~S(4)裡照規則添加
For Each Sht In Sheets
'↑設順迴圈!令Sht 是工作表之一,從前面表輪到後面表
Y = False
'↑Y這布林變數是 False
If Nx = 0 Or InStr(SS, "/" & Sht.Name & "/") > 0 Then Y = True
'↑如果Nx變數是 0,或用 InStr()函式回傳值大於 0 ??,
'InStr(如果省略，會從第一個字元位置開始搜尋 , SS字串變數, Sht迴圈工作表名前後包夾"/"符號)
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/instr-function
'if條件成立!就讓Y布林變數是 True
Sht.Visible = Y
'↑令Sht迴圈工作的顯示或隱藏隨 Y布林變數做變化
'如果輸入 0 會全部顯示!!
Next
End Sub

作者: Andy2483 時間: 2022-12-23 11:33

回復 13# 准提部林

謝謝前輩指導把工作表的顯示或隱藏用布林變數控制,看得懂,但是後學需要更努力學習才有機會應用,後學以後遇到物件的0/1變化可以回來看這帖
再次謝謝前輩

作者: goner 時間: 2022-12-23 13:12

回復 13# 准提部林

哇！俐落的控制，不用開開關關的，這樣的寫法控制似乎讓執行速度變快了，且不容易錯誤。

感謝准提部林版主，也謝謝 Andy 的熱心注釋。

這幫助很多，謝謝。

作者: lee88 時間: 2022-12-27 14:31

回復 1# goner

[attach]35672[/attach]
依你的提問如下圖片在範圍內的運作看看
[attach]35673[/attach]
總表的程式碼如下

Option Explicit
Private Sub CommandButton1_Click() '取消隱藏全部工作表的按鍵程式碼
Dim Sh As Worksheet
Application.ScreenUpdating = False
For Each Sh In Sheets
Sh.Visible = True
Next
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then HideSheet Target
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then HideSheet Target
End Sub
Sub HideSheet(Target As Range)
Dim Rng As Range, A組 As String, E As Variant
If Application.Intersect(Range("A1").CurrentRegion, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False '不觸動 Worksheet預設事件程式
On Error GoTo Err '程式產生錯誤時移到標記點
With Range("A1").CurrentRegion
Set Rng = Range(.Cells(2, Target.Column), .Cells(.Rows.Count, Target.Column))
End With
A組 = "總表" 'A組 = "總表,表1,表2,表3" ' ***可修改必須顯示的工作表
For Each E In Rng
A組 = A組 & "," & E
Set Target = E
Debug.Print TypeName(Sheets(E.Value)) ' '測試儲存格的工作表名稱是否存
Next
A組 = "," & A組 & "," '
Application.ScreenUpdating = False
For Each E In Sheets
E.Visible = InStr(UCase(A組), "," & UCase(E.Name) & ",") > 0
'* 比對完全相同的工作表名稱 ->> "," & UCase(i.Name) & ","
Next
Application.ScreenUpdating = True
Application.EnableEvents = True '回復觸動 Worksheet預設事件程式
Exit Sub
Err: '處理程式碼的錯誤
MsgBox IIf(Target <> "", " 找不到工作表 [" & Target & "]", Target.Address(0, 0) & "沒有輸入....")
Application.EnableEvents = True '回復觸動 Worksheet預設事件程式
End Sub

複製代碼

作者: Andy2483 時間: 2022-12-27 16:29

回復 19# lee88

高手雲集的論壇
謝謝前輩,後學藉此帖學習到很多知識,學習心得如下,請前輩再指導

總表_工作表明細:
[attach]35675[/attach]

工作表模組:
[attach]35676[/attach]

Module模組:
[attach]35677[/attach]

測試結果:
[attach]35678[/attach]

找不到:
[attach]35679[/attach]

作者: goner 時間: 2022-12-27 19:57

回復 19# lee88

原來還有這麼多方法，真謝謝指導，謝謝提供不一樣的使用方式。

真的很多高手^^

EXCEL的VBA會越玩越好玩，似乎什麼功能都可以達成，只可惜好像不能轉出成EXE檔。

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)