范围内的非相交地址

我有两个范围A2:E2B1:B5 。 现在如果我执行相交操作,它会返回给我B2 。 我想通过一些方法,我可以得到我的输出作为B2可以考虑在任何一个范围A2:E2B1:B5 。 即如果有重复的单元,则应该避免。

预期产出:

A2,C2:E2,B1:B5

要么

A2:E2,B1,B3:B5

谁能帮我。

喜欢这个?

 Sub Sample() Dim Rng1 As Range, Rng2 As Range Dim aCell As Range, FinalRange As Range Set Rng1 = Range("A2:E2") Set Rng2 = Range("B1:B5") Set FinalRange = Rng1 For Each aCell In Rng2 If Intersect(aCell, Rng1) Is Nothing Then Set FinalRange = Union(FinalRange, aCell) End If Next If Not FinalRange Is Nothing Then Debug.Print FinalRange.Address End Sub 

输出

 $A$2:$E$2,$B$1,$B$3:$B$5 

说明 :我在这里做的是宣布一个临时范围为FinalRange并将其设置为Range 1 。 之后,我正在检查Range 2每个单元格,如果它存在于Range 1 。 如果是这样的话,我会忽略它使用Union将其添加到Range 1

编辑问题也被交叉张贴在这里

从我的文章添加一个“减去范围”的方法与联盟与相交

这个代码可以用来

  • 从第二个范围减去一个范围的相交
  • 返回两个单独范围的反结合 (即仅排除间隔的单元)

我在Mappit中使用这个代码! 以识别隐藏的单元格(即Hidden Cells = UsedRange - SpecialCells(xlVisible) )。

虽然这个代码比较冗长,但是在较大的范围内写得很快,避免了单元循环

  Sub TestMe() Dim rng1 As Range Dim rng2 As Range Set rng1 = [a2:e2] Set rng2 = [b1:b5] MsgBox RemoveIntersect(rng1, rng2) & " " & rng2.Address(0, 0) End Sub Function RemoveIntersect(ByRef rng1 As Range, ByRef rng2 As Range, Optional bBothRanges As Boolean) As String Dim wb As Workbook Dim ws1 As Worksheet Dim rng3 As Range Dim lCalc As Long 'disable screenupdating, event code and warning messages. 'set calculation to Manual With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False lCalc = .Calculation .Calculation = xlCalculationManual End With 'add a working WorkBook Set wb = Workbooks.Add(1) Set ws1 = wb.Sheets(1) On Error Resume Next ws1.Range(rng1.Address).Formula = "=NA()" ws1.Range(rng2.Address).Formula = vbNullString Set rng3 = ws1.Cells.SpecialCells(xlCellTypeFormulas, 16) If bBothRanges Then ws1.UsedRange.Cells.ClearContents ws1.Range(rng2.Address).Formula = "=NA()" ws1.Range(rng1.Address).Formula = vbNullString Set rng3 = Union(rng3, ws1.Cells.SpecialCells(xlCellTypeFormulas, 16)) End If On Error GoTo 0 If Not rng3 Is Nothing Then RemoveIntersect = rng3.Address(0, 0) 'Close the working file wb.Close False 'cleanup user interface and settings 'reset calculation With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True lCalc = .Calculation End With End Function