如何更改多个非连续范围的选定范围中的部分选定范围

Question

我将尝试通过仅着重解决问题并解决所有非必要问题/脚本来说明该情况。

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

例如，

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