如何隐藏/取消隐藏在范围边界添加的列

Question

我正在尝试创建一个宏，它将隐藏/取消隐藏指定范围的列。在命名范围内添加列没有问题，但是当在此范围的边界添加列时 - 宏不起作用。例如，AM：BF是我的工作表中的命名范围（"家具"）。我需要添加一个列 BG，它也将被宏隐藏。在左边框添加新列时的情况相同。您能否指导我如何改进代码，以便在范围边界添加的列也将隐藏/取消隐藏？

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