如何隱藏/取消隱藏在範圍邊界添加的列

Question

我試圖創建一個宏來隱藏/取消隱藏指定範圍的列。 在指定範圍內添加列並不成問題，但在此範圍的邊界處添加列時 - 宏不起作用。例如，AM：BF是我的工作表中命名的範圍（「傢俱」）。我需要添加一個列，它也會被宏隱藏。在左邊框上添加新列時也是如此。你能指導我如何改進代碼，以便在範圍邊界處添加的列也將隱藏/不隱藏？

With ThisWorkbook.Sheets("Sheet1").Range("Furniture").EntireColumn 
.Hidden = Not .Hidden 
End With 

Answer 1

我添加了一個變量RangeName（的String型），等於給名稱範圍=「傢俱」的名稱。

代碼

Option Explicit 

Sub DynamicNamedRanges() 

Dim WBName As Name 
Dim RangeName As String 
Dim FurnitureNameRange As Name 
Dim Col As Object 
Dim i As Long 

RangeName = "Furniture" ' <-- a String representing the name of the "Named Range" 

' loop through all Names in Workbook  
For Each WBName In ThisWorkbook.Names 
    If WBName.Name Like RangeName Then '<-- search for name "Furniture" 
     Set FurnitureNameRange = WBName 
     Exit For 
    End If 
Next WBName 

' adding a column to the right of the named range (Column BG) 
If Not FurnitureNameRange Is Nothing Then '<-- verify that the Name range "Furnitue" was found in workbook 
    FurnitureNameRange.RefersTo = FurnitureNameRange.RefersToRange.Resize(Range(RangeName).Rows.Count, Range(RangeName).Columns.Count + 1) 
End If 

' loop through all columns of Named Range and Hide/Unhide them 
For i = 1 To FurnitureNameRange.RefersToRange.Columns.Count 
    With FurnitureNameRange.RefersToRange.Range(Cells(1, i), Cells(1, i)).EntireColumn 
     .Hidden = Not .Hidden 
    End With 
Next i 

End Sub 

Answer 2

發生在您的工作表的代碼窗格中的以下內容：

Option Explicit 

Dim FurnitureNameRange As Name 
Dim adjacentRng As Range 
Dim colOffset As Long 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim newRng As Range 

    If colOffset = 1 Then Exit Sub 

    On Error GoTo ExitSub 
    Set adjacentRng = Range(adjacentRng.Address) 

    With ActiveSheet.Names 
     With .Item("Furniture") 
      Set newRng = .RefersToRange 
      .Delete 
     End With 
     .Add Name:="Furniture", RefersTo:="=" & ActiveSheet.Name & "!" & newRng.Offset(, colOffset).Resize(, newRng.Columns.Count + 1).Address 
    End With 

ExitSub: 
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    On Error Resume Next 
    Set FurnitureNameRange = ActiveSheet.Names("Furniture") 'ThisWorkbook.Names("Furniture") 
    On Error GoTo 0 

    colOffset = 1 
    Set adjacentRng = Nothing 
    If FurnitureNameRange Is Nothing Then Exit Sub 
    Set adjacentRng = Target.EntireColumn 
    With FurnitureNameRange.RefersToRange 
     Select Case Target.EntireColumn.Column 
      Case .Columns(1).Column - 1 
       colOffset = -1 
      Case .Columns(.Columns.Count).Column + 1 
       colOffset = 0 
     End Select 
    End With 
End Sub