vba - 删除行后更改选择？

Question

旺旺

 Loop through multiple selection areas (r = 1 to n)
   Delete rows in area r
 Next area

备注
选择可以是不连续的，并且可以是任何(垂直)顺序。 IE。区域 1 可以是第 8-10 行，区域 2 可以是第 2-3 行，区域 3 可以是第 14-18 行。选定的单元格区域不应重叠以防止错误。

问题
在一个区域中执行行删除会导致下面的所有数据上移。下面的选定区域不会移动。因此，新数据(您不想删除)会滚动到选定区域。

示例

Row 1: A B C
Row 2: D E F  (Select R2C1:R2C3 first)
Row 3: G H I
Row 4: J K L  (CTRL Select R4C1:R4C3 next)
Row 5: M N O

选择了 2 个区域。我们希望删除第 2 行和第 4 行。

代码

For aCounter = 1 to Selection.Areas.Count
   Selection.Areas(aCounter).EntireRow.Delete
Next

结果

Row 1: A B C
Row 2: G H I  (This row is selected)
Row 3: J K L
Row 4: (blank) (This row is also selected)
Row 5: (blank)

发生了什么
选择的第一个区域 (Areas(1)) 是第 2 行，已被删除。第 3-5 行卷起，但第 2 行仍保留第 2 行。这意味着 J K L 进入第 3 行，而 M N O 进入第 4 行。在下一个循环中，Areas(2) 仍设置为第 4 行，因此 M N O 是删除。

应该发生什么
Areas(2) 应该向上移动了删除的行数。

问题
有没有一种方法可以轻松编写代码，而无需遍历所有区域，检查它们是否低于已删除的行，并在每次删除一行时将它们向上移动删除的行数？

Answer 1

使用联合删除1次:(无重叠区域)

Sub try()
Dim MyRng As Range

For aCounter = 1 To Selection.Areas.Count
    If Not MyRng Is Nothing Then
        Set MyRng = Application.Union(MyRng, Selection.Areas(aCounter))
    Else
        Set MyRng = Selection.Areas(aCounter)
    End If
Next
MyRng.EntireRow.Delete
End Sub

重叠区域:

Sub try2()
Dim MyRng As Range, MyRow As Range

For aCounter = 1 To Selection.Areas.Count
    If Not MyRng Is Nothing Then
        For Each MyRow In Selection.Areas(aCounter).Rows
        If Intersect(MyRow, MyRng) Is Nothing Then
        Set MyRng = Application.Union(MyRng, MyRow)
        End If
        Next MyRow
    Else
        Set MyRng = Selection.Areas(aCounter)
    End If
Next
MyRng.EntireRow.Delete
End Sub