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

时间:2017-02-02 09:43:40

标签: excel vba excel-vba

我试图创建一个隐藏/取消隐藏指定范围列的宏。 在命名范围内添加列是没有问题的,但是当在此范围的边界添加列时 - 宏不起作用。例如,AM:BF是我工作表中的命名范围(" Furniture")。我需要添加一个列BG,它也将被宏隐藏。在左边框上添加新列时也是如此。你能指导我如何改进代码,以便在范围的边界添加的列也将被隐藏/取消隐藏吗?

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

2 个答案:

答案 0 :(得分:0)

我添加了一个变量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

答案 1 :(得分:0)

将以下内容放在工作表代码窗格中:

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