3

我有两个范围A2:E2B1:B5. 现在,如果我执行 intersect 操作,它将返回 me B2。我想要某种方式来获得我的输出,B2以便在任何一个范围内考虑A2:E2B1:B5。即,如果有重复的单元格,那么应该避免。

预期输出:

A2,C2:E2,B1:B5

或者

A2:E2,B1,B3:B5

谁能帮我。

4

2 回答 2

4

像这样?

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. 如果是,那么我将忽略它,否则将其添加UnionRange 1

编辑问题也在这里交叉发布

于 2012-08-17T06:25:56.550 回答
3

来自我的文章在 Union & Intersect 旁边添加“减去范围”方法

此代码可用于

  • 从第二个范围减去一个范围的交集
  • 返回两个独立范围的反联合(即仅排除相交的单元格)

我在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
于 2012-08-17T06:35:08.947 回答