Board logo

標題: [發問] 在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的熱心幫忙以及各位的回覆,現在找到原因囉^^
檢視 [區域變數] 視窗,發現其中有個變數多了一個 "雙引號,而導致無法正確判斷工作表名稱,調整後已可正常使用功能。
  1. Option Explicit
  2. Sub 工作表顯示隱藏控制()
  3. Application.ScreenUpdating = False

  4. Dim N%, i&, xR, V, Y, Z, No, G1, G2, G3
  5. No = InputBox("請輸入 0~4 數字!", "工作表顯示隱藏控制", 0)

  6. If No < 0 Or No > 4 Then Exit Sub

  7. Set Y = CreateObject("Scripting.Dictionary")
  8. V = [A1]    ' 這裡配合巨集 收集15個工作表名() 使用,蒐集目前活頁簿所有工作表名稱。
  9. V = Split(V, ",")
  10. For Each xR In [A1:E1]
  11.    Z = Split(xR.Address, "$")(1)
  12.    Y(Z) = Array(V(1 + N), V(2 + N), V(3 + N))
  13.    N = N + 3
  14. Next

  15. For Each xR In ActiveWorkbook.Worksheets
  16.    xR.Visible = True
  17. Next

  18. If No = 0 Then GoTo 111:

  19. Select Case No
  20.     Case 1: G1 = Y("C"): G2 = Y("D"): G3 = Y("E")
  21.     Case 2: G1 = Y("B"): G2 = Y("D"): G3 = Y("E")
  22.     Case 3: G1 = Y("B"): G2 = Y("C"): G3 = Y("E")
  23.     Case 4: G1 = Y("B"): G2 = Y("C"): G3 = Y("D")
  24. End Select
  25. Sheets(G1).Visible = False
  26. Sheets(G2).Visible = False
  27. Sheets(G3).Visible = False

  28. 111:
  29. ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
  30. Set Y = Nothing
  31. Erase V
  32. End Sub

  33. '執行下列程式碼可取得 15個工作表名的字串
  34. Sub 收集15個工作表名()

  35. Dim i&, Na$
  36. For i = 1 To 15
  37.    Na = Na & "," & Sheets(i).Name
  38. Next
  39. 'Workbooks.Add    ' 以原有活頁簿使用,所以不新增活頁簿。
  40. [A1] = "V=""" & Na & ""    ' 這裡有做調整。原[A1] = "V = """ & Na & """"  變數會多了一個 "雙引號,而導致無法正確判斷工作表名稱。

  41. End Sub
  42. '把 15個工作表名的字串 與上方紅字置換掉
複製代碼
以下是一次 取消隱藏 所有工作表程式碼,供參考。
  1. Sub UnhideAllSheets()
  2.         Dim UAS As Worksheet

  3.         For Each UAS In ActiveWorkbook.Worksheets
  4.                 UAS.Visible = xlSheetVisible
  5.         Next UAS

  6. 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]
總表的程式碼如下
  1. Option Explicit
  2. Private Sub CommandButton1_Click()  '取消隱藏全部工作表的按鍵程式碼
  3.         Dim Sh As Worksheet
  4.         Application.ScreenUpdating = False
  5.         For Each Sh In Sheets
  6.             Sh.Visible = True
  7.         Next
  8.         Application.ScreenUpdating = True
  9. End Sub
  10. Private Sub Worksheet_Change(ByVal Target As Range)
  11.         If Target.Count = 1 Then HideSheet Target
  12. End Sub
  13. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  14.     If Target.Count = 1 Then HideSheet Target
  15. End Sub
  16. Sub HideSheet(Target As Range)
  17.     Dim Rng As Range, A組 As String, E As Variant
  18.     If Application.Intersect(Range("A1").CurrentRegion, Target) Is Nothing Then Exit Sub
  19.     Application.EnableEvents = False       '不觸動 Worksheet預設事件程式
  20.     On Error GoTo Err                                    '程式產生錯誤時移到 標記點
  21.     With Range("A1").CurrentRegion
  22.         Set Rng = Range(.Cells(2, Target.Column), .Cells(.Rows.Count, Target.Column))
  23.     End With
  24.     A組 = "總表"    'A組 = "總表,表1,表2,表3"    ' ***可修改 必須顯示的工作表
  25.     For Each E In Rng
  26.         A組 = A組 & "," & E
  27.         Set Target = E
  28.         Debug.Print TypeName(Sheets(E.Value)) ' '測試儲存格的工作表名稱是否存
  29.     Next
  30.     A組 = "," & A組 & "," '
  31.     Application.ScreenUpdating = False
  32.     For Each E In Sheets
  33.             E.Visible = InStr(UCase(A組), "," & UCase(E.Name) & ",") > 0
  34.             '* 比對完全相同的工作表名稱 ->>     "," & UCase(i.Name) & ","
  35.     Next
  36.     Application.ScreenUpdating = True
  37.     Application.EnableEvents = True      '回復觸動 Worksheet預設事件程式
  38.     Exit Sub
  39. Err:                          '處理程式碼的錯誤
  40.     MsgBox IIf(Target <> "", "  找不到 工作表 [" & Target & "]", Target.Address(0, 0) & "沒有輸入....")
  41.     Application.EnableEvents = True      '回復觸動 Worksheet預設事件程式
  42. 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/)