返回列表 上一主題 發帖

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

[發問] 在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:23 編輯

回復 1# goner


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


輸入窗輸入 1 結果:
2.jpg
2022-12-20 09:58


輸入窗輸入 2結果:
3.jpg
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個工作表名的字串 與上方紅字置換掉
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

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

4.jpg
2022-12-20 10:39
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

感謝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組工作表 不會執行到隱藏。
螢幕擷取畫面_20221220_024725.png
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個工作表名的字串 與上方紅字置換掉

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

TOP

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

TOP

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

回復 4# goner


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

2022-12-20_164748.JPG
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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 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
複製代碼

TOP

回復 6# Andy2483


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

TOP

本帖最後由 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個工作表名的字串 與上方紅字置換掉
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

回復 9# Andy2483


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

TOP

        靜思自在 : 愛不是要求對方,而是要由自身的付出。
返回列表 上一主題