返回列表 上一主題 發帖

不同名稱隱藏

本帖最後由 GBKEE 於 2012-8-30 14:36 編輯

回復 1# myleoyes
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Application.EnableEvents = False
  3.     If Target(1).Row = 2 Then           '在第2列
  4.          Select Case Target(1).Column
  5.         Case 1
  6.               With ActiveWindow         '移除視窗分割
  7.                 .SplitColumn = 0
  8.                 .SplitRow = 0
  9.             End With
  10.             Cells.EntireColumn.Hidden = True
  11.             [A1:F1].Cells.EntireColumn.Hidden = False
  12.             [A1].Select
  13.         Case 2 To 5                     'B2:E2
  14.             隱藏 Target(1)
  15.     End Select
  16.     End If
  17.     Application.EnableEvents = True
  18. End Sub

  19. Sub 隱藏(xLRng As Range)
  20.     Dim Rng As Range, xF As Range
  21.     Set Rng = Range("A2, F2" )
  22.     Cells.EntireColumn.Hidden = False
  23.     Set xF = Rows(2).Find(xLRng, LOOKAT:=xlPart, LookIn:=xlValues)   '尋找
  24.     Do
  25.         Set Rng = Union(Rng, xF)
  26.         Set xF = Rows(2).FindNext(xF)
  27.     Loop While xLRng.Address <> xF.Address  '一直到是第一尋找到的位置
  28.     Cells.EntireColumn.Hidden = True
  29.     Rng.EntireColumn.Hidden = False
  30.     Rng.Select
  31.     With ActiveWindow
  32.         .SplitColumn = 6
  33.         .SplitRow = 2
  34.         .FreezePanes = True
  35.     End With
  36. End Sub
複製代碼

TOP

回復 5# myleoyes
再試試看
  1. Sub 隱藏(xLRng As Range)
  2.     Dim Rng As Range, xF As Range
  3.     Set Rng = Range("A2, F2")
  4.     Cells.EntireColumn.Hidden = False
  5.     Set xF = Rows(2).Find(xLRng, xLRng.Offset(, -1), LOOKAT:=xlPart, LookIn:=xlValues) '尋找
  6.     Do
  7.         Set Rng = Union(Rng, xF)
  8.         Set xF = Rows(2).FindNext(xF)
  9.     Loop While xLRng.Address <> xF.Address  '一直到是第一尋找到的位置
  10.     Cells.EntireColumn.Hidden = True
  11.     Rng.EntireColumn.Hidden = False
  12.     Rng.Select
  13.     With ActiveWindow
  14.         .SplitColumn = 6
  15.         .SplitRow = 2
  16.         .FreezePanes = True
  17.     End With
  18. End Sub
複製代碼

TOP

回復 7# myleoyes
是這樣嗎?
  1. Sub 數據()
  2.     zz = Application.InputBox("輸入數據", "請輸入修正數據", Type:=1)
  3.     If zz = 0 Then Exit Sub
  4.     ActiveCell = zz: [D1] = ""
  5.     Selection.Resize(2).AutoFill Range(Selection, Cells([B100].End(3).Row, Selection.Column)), Type:=xlFillDefault
  6.     [D1] = "'分析"
  7. End Sub
複製代碼

TOP

本帖最後由 GBKEE 於 2012-9-1 14:37 編輯

回復 9# myleoyes
有幸會解答是不辛苦的,只是不明嘹問題很辛苦啦.要修改什麼,可以用文字敘述嗎?

TOP

        靜思自在 : 一句溫暖的話,就像往別人身上灑香水,自己會沾到兩三滴。
返回列表 上一主題