返回列表 上一主題 發帖

不同名稱隱藏

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 2012-8-29 21:33 | 顯示全部帖子
各位前輩你們好!
         前輩!!需求如動畫所示!
         因為欄數不段增加所以不能用錄製方式
       ...
myleoyes 發表於 2012-8-29 12:03
  1. Sub 分析隱藏()
  2.     Dim iCols%, iI%, vCol
  3.   
  4.     [B3].Select
  5.     ActiveWindow.FreezePanes = False
  6.     iCols = Cells(2, Columns.Count).End(xlToLeft).Column
  7.     Set vCol = Range(Cells(3), Cells(5))
  8.     iI = 8
  9.     Do
  10.     Set vCol = Application.Union(vCol, Range(Cells(iI), Cells(iI + 2)))
  11.     iI = iI + 4
  12.     Loop Until iI > iCols
  13.     vCol.EntireColumn.Hidden = True
  14.    
  15.     '[C:E,H:J,L:N,P:R,T:V,X:Z].EntireColumn.Hidden = True
  16.    
  17.     [G3].Select
  18.     ActiveWindow.FreezePanes = True
  19. End Sub
  20. Sub 資料隱藏()
  21.     Dim iCols%, iI%, vCol
  22.   
  23.     [B3].Select
  24.     ActiveWindow.FreezePanes = False
  25.     iCols = Cells(2, Columns.Count).End(xlToLeft).Column
  26.     Set vCol = Application.Union(Cells(2), Cells(4), Cells(5), Cells(7))
  27.     iI = 9
  28.     Do
  29.     Set vCol = Application.Union(vCol, Range(Cells(iI), Cells(iI + 2)))
  30.     iI = iI + 4
  31.     Loop Until iI > iCols
  32.     vCol.EntireColumn.Hidden = True
  33.    
  34.     '[B:B,D:E,G:G,I:K,M:O,Q:S,U:W,Y:AA].EntireColumn.Hidden = True
  35.    
  36.     [H3].Select
  37.     ActiveWindow.FreezePanes = True
  38. End Sub
複製代碼
其他的只要參照上述程式內容適當的套用即可完成,
這裡就不再列出來囉.

TOP

        靜思自在 : 要用心，不要操心、煩心。
返回列表 上一主題