从范围中排除多个单元格

Question

我的问题是如何从范围对象中删除一个或多个单元格？我早些时候问了一些非常类似的问题，有些人向我指出了这个问题：从范围(对象(中删除单元格

接受的答案：

Function getExcluded(ByVal rngMain As Range, rngExc As Range) As Range
Dim rngTemp     As Range
Dim rng         As Range
Set rngTemp = rngMain
Set rngMain = Nothing
For Each rng In rngTemp
If rng.Address <> rngExc.Address Then
If rngMain Is Nothing Then
Set rngMain = rng
Else
Set rngMain = Union(rngMain, rng)
End If
End If
Next
Set getExcluded = rngMain
End Function

Sub test()
MsgBox getExcluded(Range("A1:M10000"), Range("a10")).Address
End Sub

只有当排除的范围是一个单元格时，接受的答案才有效-至少我尝试时是这样的。我要排除的单元格通常有多个单元格，所以我尝试调整代码：

我的尝试：

Function getExcluded(ByVal rngMain As Range, rngExcl As Range) As Range
Dim rngTemp As Range
Dim cellTemp As Range, cellExcl As Range
Set rngTemp = rngMain
Set rngMain = Nothing
For Each cellTemp In rngTemp 'go through all cells in established range
If Intersect(cellTemp, rngExcl) Is Nothing Then 'check for each cell if it intersects with the range to be excluded; no overlap -> put it into rngMain
If rngMain Is Nothing Then
Set rngMain = cellTemp
Else
rngMain = Union(rngMain, cellTemp)
End If
Debug.Print "cellTemp: " & cellTemp.Address
Debug.Print "rngMain: " & rngMain.Address
End If
Next cellTemp
Set getExcluded = rngMain

Sub test5()
getExcluded(Range("A1:D3"), Range("B1:C1")).Select
End Sub

问题似乎出现在线路Set rngMain = Union(rngMain, rng)中。我的Debug.Print语句告诉我，cellTemp正在按应有的方式迭代；然而，即使具有Union的行被执行，并且无论cellTemp是什么，rngMain都保持$A$1

我做错了什么？

Answer 1

在@Nathan_Sav上构建。

这将允许添加许多排除范围：

Function testexclude(rngMain As Range, ParamArray rngExclude() As Variant) As Range

Dim i As Long
For i = LBound(rngExclude, 1) To UBound(rngExclude, 1)
Dim rngexcluderng As Range
If rngexcluderng Is Nothing Then
Set rngexcluderng = rngExclude(i)
Else
Set rngexcluderng = Union(rngexcluderng, rngExclude(i))
End If
Next i

Dim c As Range
For Each c In rngMain
If Intersect(c, rngexcluderng) Is Nothing Then
Dim r As Range
If r Is Nothing Then
Set r = c
Else
Set r = Union(r, c)
End If
End If
Next c
Set testexclude = r
End Function

Answer 2

类似的东西，设置并集范围也是

Function testexclude(rngMain As Excel.Range, rngExclude As Excel.Range) As Excel.Range
Dim c As Excel.Range
Dim r As Excel.Range
For Each c In rngMain
If Intersect(c, rngExclude) Is Nothing Then
If r Is Nothing Then
Set r = c
Else
Set r = Union(r, c)
End If
End If
Next c
Set testexclude = r
End Function