arrays - 如何在多个非连续范围的选择中更改所选范围的一部分

Question

我将尝试通过仅关注问题并删除所有非必要问题/脚本来说明场景。

用户选择多个不连续的单元格。VBA 会做一些事情......然后插入一列。如果选定的单元格恰好位于列的右侧，则内容将在原始选定单元格的右侧移动一列。在退出子之前，我需要重新选择具有原始内容的单元格。

例如，

1. 用户选择“A1”、“C3”和“D4:E6”。
2. vba 在“B”处插入一列
3. 现在“C3”和“D4:E6”的内容移动到“D3”和“E4:F6”
4. 我需要 vba 在退出子之前选择“A1”、“D3”和“E4:F6”。

我考虑了几种方法：

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 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

Answer 2

如果为范围指定名称，则在插入列后将调整单元格：

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