範囲の境界に追加された列の非表示/非表示方法

Question

指定した範囲の列を表示/非表示にするマクロを作成しようとしています。 名前付き範囲内に列を追加することは問題ありませんが、この範囲の境界に列を追加するとマクロが機能しません。たとえば、AM：BFはシートの名前付き範囲（「家具」）です。マクロによって隠される列BGを追加する必要があります。左端に新しい列を追加するときも同じ話です。範囲の境界に追加された列も非表示/非表示になるようにコードを改善する方法を教えてください。

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

Answer 1

私は名前範囲=「家具」の名に等しい（タイプStringの）変数RangeNameを追加しました。

コード

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