楼主
芐雨 |
Q：如何用VBA求出两个区域的差集，交集，并集？
A：
差集:
一般地，记A，B是两个集合，则所有属于A且不属于B的元素构成的集合，叫做集合A减集合B（或集合A与集合B之差），类似地，对于集合A、B，我们把集合{x∣x∈A,且x∉B}叫做A与B的差集。
交集：
A 和 B 的交集是含有所有既属于 A 又属于 B 的元素，而没有其他元素的集合。
并集：
一般地，对于两个给定的集合A,B，把所有属于集合A或属于集合B的元素所组成的集合(两个集合全部元素加起来的全部元素所组成的集合）叫做并集，记作A∪B。
我们可以把集合看成一个区域，区域A，区域B，交集并集可以直接用VBA函数来实现
A与B的交集：Intersect(A, B)
A与B的并集：Union(A, B)
差集可以通过下面代码实现：（不过限于连续的区域）
- Sub 两个区域的差集_芐雨()
- Dim A As Range, B As Range, J As Range
- Dim arr As Range, arr1 As Range, arr2 As Range, arr3 As Range, arr4 As Range
- On Error Resume Next
- ActiveSheet.Cells.Clear
- Set A = Application.InputBox(prompt:="选择区域", Type:=8)
- A.Interior.ColorIndex = 44
- Set B = Application.InputBox(prompt:="选择区域", Type:=8)
- B.Interior.ColorIndex = 8
- Set J = Intersect(A, B) 'J为A,B两个区域的交集
- J.Interior.ColorIndex = 3
- If J Is Nothing Then 'A,B这两个区域不相交，A为差集
- A.Borders.ColorIndex = 1
- MsgBox "有边框的区域是差集"
- Exit Sub
- End If
- If J.Address = A.Address Then '交集J就是A,那么无差集
- MsgBox "无差集"
- Exit Sub
- End If
- Set l = Union(A, B) 'l为A,B两个区域的并集
- Set arr1 = l(l.Count).Offset(0, 1) '定义这四个区域，防止下面为nothing时，用union连接出错
- Set arr2 = l(l.Count).Offset(0, 1)
- Set arr3 = l(l.Count).Offset(0, 1)
- Set arr4 = l(l.Count).Offset(0, 1)
- If A(1).Column < J(1).Column Then Set arr1 = Range(A(1), J(1).Offset(0, -1)).EntireColumn '如果A的首列小于交集J的首列，定义arr1为A首列到J首列前一列的所有列
- If A(1).Row < J(1).Row Then Set arr2 = Range(A(1), J(1).Offset(-1, 0)).EntireRow '如果A的首行小于交集J的首行，定义arr2为A首行到J首行前一行的所有行
- If A(A.Count).Column > J(J.Count).Column Then Set arr3 = Range(A(A.Count), J(J.Count).Offset(0, 1)).EntireColumn '如果A的尾列小于交集J的尾列，定义arr1为A尾列到J尾列前一列的所有列
- If A(A.Count).Row > J(J.Count).Row Then Set arr4 = Range(A(A.Count), J(J.Count).Offset(1, 0)).EntireRow '如果A的尾行小于交集J的尾行，定义arr2为A尾行到J尾行后一行的所有行
- Set arr = Intersect(Union(arr1, arr2, arr3, arr4), A)
- arr.Borders.ColorIndex = 1
- MsgBox "有边框的区域是差集"
- End Sub
|
xuexue