Question

我有两个范围A2:E2和B1:B5。现在，如果我执行交叉操作，它将返回B2。我希望通过某种方式，我可以将B2的输出作为A2:E2和B1:B5的任何一个范围来考虑。即如果有重复的细胞则应该避免。

预期输出：

A2,C2:E2,B1:B5

OR

A2:E2,B1,B3:B5

任何人都可以帮助我。

Answer 1

喜欢这个吗？

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

编辑问题也已发布here

Answer 2

从我的文章Adding a "Subtract Range" method alongside Union & Intersect

此代码可用于

从第二个范围中减去一个范围的交叉
返回两个不同范围的反联盟（即只排除intersetc的单元格）

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

Range中的非相交地址

2 个答案: