同一范围内的重叠区域、重复的单元格

Question

考虑以下代码：

Dim rng As Range
Dim rngCell As Range

Set rng = ActiveSheet.Cells(2, 2).Resize(3, 3)
Set rng = Union(rng, ActiveSheet.Cells(3, 3).Resize(3, 3))
Set rng = Union(rng, ActiveSheet.Cells(4, 4).Resize(3, 3))

'Shows 27, should be 19
MsgBox rng.Cells.Count

rng.ClearContents
For Each rngCell In rng.Cells
    rngCell = rngCell + 1
Next rngCell

结果是：

基本上，代码会生成一个范围变量，其中包含 3 个重叠区域。当使用 For Each 迭代单元格时，某些单元格会被多次访问。此外，Cells.Count 显示的数字高于范围内（唯一）单元格的实际数量。

如何展平/折叠这 3 个区域以免重叠？

Answer 1

• rng.Address

  是

  $B$2:$D$4,$C$3:$E$5,$D$4:$F$6

  。

  Union

  创建一个覆盖两个范围的范围，但不会删除重复的单元格。

• mergeRng.Address

  是

  $B$2:$D$4,$E$3:$E$4,$F$4,$C$5:$F$5,$D$6:$F$6

  。

  mergeRng

  是通过

  Union

  操作重复添加单个细胞而形成的。

Option Explicit

Sub Demo()
    Dim rng As Range
    Dim rngCell As Range
    Dim mergeRng As Range
    Set rng = ActiveSheet.Cells(2, 2).Resize(3, 3)
    Set rng = Union(rng, ActiveSheet.Cells(3, 3).Resize(3, 3))
    Set rng = Union(rng, ActiveSheet.Cells(4, 4).Resize(3, 3))
    
    'Shows 27, should be 19
    Debug.Print rng.Cells.Count
    Debug.Print rng.Address
    
    For Each rngCell In rng.Cells
        If mergeRng Is Nothing Then
            Set mergeRng = rngCell
        Else
            Set mergeRng = Union(mergeRng, rngCell)
        End If
    Next rngCell
    Debug.Print mergeRng.Cells.Count
    Debug.Print mergeRng.Address
    mergeRng.ClearContents
    For Each rngCell In mergeRng.Cells
        rngCell = rngCell + 1
    Next rngCell
End Sub