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

Vba 如何隐藏/取消隐藏在范围边界处添加的列,vba,excel,Vba,Excel,我正在尝试创建一个宏,它将隐藏/取消隐藏指定范围的列。 在命名范围内添加列没有问题,但在该范围的边界处添加列时,宏不起作用。例如,AM:BF是我的工作表中的命名范围(“家具”)。我需要添加一列BG,它也将被宏隐藏。在左边框上添加新列时的情况与此相同。您能指导我如何改进代码,以便在范围边界添加的列也将被隐藏/取消隐藏吗 With ThisWorkbook.Sheets("Sheet1").Range("Furniture").EntireColumn .Hidden = Not .Hidden

我正在尝试创建一个宏,它将隐藏/取消隐藏指定范围的列。 在命名范围内添加列没有问题,但在该范围的边界处添加列时,宏不起作用。例如,AM:BF是我的工作表中的命名范围(“家具”)。我需要添加一列BG,它也将被宏隐藏。在左边框上添加新列时的情况与此相同。您能指导我如何改进代码,以便在范围边界添加的列也将被隐藏/取消隐藏吗

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

我添加了一个变量
RangeName
(类型为
String
),该变量等于name Range=“Furniture”的名称

代码

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
选项显式
子动态名称()
将WBName作为名称
将RangeName设置为字符串
Dim FurnitureNameRange作为名称
作为对象的颜色
我想我会坚持多久

RangeName=“Furniture”在工作表代码窗格中放置以下内容:

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

将列添加到边框时,需要调整命名区域的大小。左边框是否总是同一列?