arrays - 複数の連続しない範囲の選択で、選択範囲の一部を変更する方法

Question

問題のみに焦点を当ててシナリオを説明し、重要ではない問題/スクリプトをすべて取り上げます。

ユーザーが複数の連続していないセルを選択しました。VBA はいくつかのことを行います...次に、列を挿入します。選択したセルがたまたま列の右側にあった場合、コンテンツは元の選択したセルの 1 列右に移動します。サブを終了する前に、元のコンテンツを含むセルを再選択する必要があります。

例えば、

1. ユーザーは「A1」、「C3」、および「D4:E6」を選択します。
2. vbaは「B」に列を挿入します
3. 「C3」と「D4:E6」の内容が「D3」と「E4:F6」に移動するようになりました
4. サブを終了する前に、「A1」、「D3」、および「E4：F6」を選択するには、vbaが必要です。

私はいくつかの方法を検討しました：

1. 選択範囲全体を 1 列右にオフセットします。

   selection.offset(0,1).select

   「A1」が「B1」に移動するため、これは良い解決策ではありません。ユーザーが選択したセルがすべて挿入された列の右側にある場合にのみ問題ありません。

2. 選択範囲（選択範囲）の各セルを配列に入れます。影響を受けるセルの範囲を変更します。そして、vba を使用してそれらをすべて再度選択します。問題は、私が書いた vba が範囲の配列全体 (複数の連続していないセル) を一度に選択できないことです。配列の最後のセルのみを選択します。要約されたコードは次のとおりです。

   Sub mtArea()
   
   Dim Cell, Rg, sRg() As Range
   Dim h, i, j, k, noCell, Cnt As Long
   Set Rg = Selection
   
   noCell = Rg.Cells.Count
   k = 0
   
   ' assign each cell in selection to a specific array
   
   If Rg.Areas.Count > 1 Then
      ReDim sRg(noCell)
      For Each Cell In Rg
         k = k + 1
         Set sRg(k) = Cell
      Next Cell
   End If
   
   ' select the new located cells
   
   For i = 1 To noCell
    If sRg(i).Column > 5 Then ' assuming insert column is "E"
      h = 1
    Else
      h = 0
    End If
   sRg(i).Offset(0, h).Select
   Next i
   
   End Sub
   

   この場合、元の範囲の最後のセルのみが選択されています。sRg() 範囲配列全体を選択する方法はありますか?

3. また、次の方法で調査したいと考えています。

   Dim Rg as Range
   Set Rg = Selection
   

   ユーザーが複数の連続していないセルを選択した場合、vba が Rg 変数の個々のセル範囲の場所を変更する方法はありますか?

方法は何ですか？

ありがとうございました。

Answer 1

範囲に名前を割り当てると、列が挿入された後にセルが調整されます。

Sub RememberTheCells()
    Range("A1,C3,D4:E6").Select
    Selection.Name = "Previous"
    Columns("B:B").Insert Shift:=xlToRight
    Range("Previous").Select
    MsgBox Selection.Address
End Sub

Answer 2

これを試して

Sub InsertDemo()
    InsertAndAdjustSelection 2

End Sub

Sub InsertAndAdjustSelection(Col As Long)
    Dim strAddress() As String
    Dim i As Long

    ' Save adresses of selected cells
    strAddress = Split(Selection.Address, ",")

    ' Insert Column
    Columns(Col).Insert

    ' Unpdate saved addresses
    For i = 0 To UBound(strAddress)
        If Range(strAddress(i)).Column >= Col Then
            strAddress(i) = Range(strAddress(i)).Offset(, 1).Address
        End If
    Next

    ' Select range
    Range(Join(strAddress, ",")).Select
End Sub