我有两个范围A2:E2
和B1:B5
。现在,如果我执行交叉操作,它将返回我B2
。我想要某种方式,通过这种方法,我可以在A2:E2
和B1:B5
的任何一个范围内将我的输出作为B2
考虑。即,如果有一个重复的单元格,则应避免使用。
预期输出 :
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
编辑问题也交叉发布在这里
来自我的文章 在 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