楼主
天南地北 |
Q:如何统计两列有重复数据的交集、并集、差集？
- A、B两列数据存在重复和空值情形，有要求统计A-B（A列有B列没有的），B-A（B列有A列没有的），A∩B(AB列都有的称为交集），A∪B（A或者B列有的称为并集）
A：可以通过如下字典嵌套数组实现
- Sub 差集交集并集_天南地北() 'F列输出满后再向G列输出的，但F列到 F65525 就向G列输出了？
- On Error Resume Next
- Dim arr, ar, i&, x&, y&, r&, k&, Crr1
- t = Timer
- Application.ScreenUpdating = False
- Range("C2:G" & Rows.Count).ClearContents
- arr = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
- ar = Range("B2:B" & Cells(Rows.Count, 2).End(3).Row)
- ReDim CRR(1 To UBound(arr) + UBound(ar), 0 To 3)
- Set dic = CreateObject("scripting.dictionary")
- Set d = CreateObject("scripting.dictionary")
- For i = 1 To UBound(arr)
- dic(arr(i, 1)) = i
- d(arr(i, 1)) = ""
- CRR(i, 3) = arr(i, 1) '记入brr，合成部分
- Next
- For i = 1 To UBound(ar)
- If dic.exists(ar(i, 1)) Then
- y = y + 1
- CRR(y, 2) = ar(i, 1) '记入crr,AB共有
- d.Remove (ar(i, 1)) '记入D，删除B在A的数，A有B没有部分
- Else
- x = x + 1
- dic(ar(i, 1)) = UBound(arr) + x
- CRR(UBound(arr) + x, 3) = ar(i, 1) '记入brr，合成部分
- CRR(x, 1) = ar(i, 1) '记入crr，B有A没有
- End If
- Next
- r = UBound(arr) + x
- For Each ky In d.keys '遍历所有keys,放入数crr(i,0)中A有B没有部分
- J = J + 1
- CRR(J, 0) = ky
- Next
- d.RemoveAll
- ReDim Crr1(1 To r, 1 To 5)
- For J = 0 To 3
- Set d = CreateObject("scripting.dictionary")
- n = 0
- For i = 1 To r
- If CRR(i, J) <> "" Then
- If Not d.exists(CRR(i, J)) Then
- n = n + 1
- d(CRR(i, J)) = n
- Crr1(n, J + 1) = CRR(i, J)
- End If
- End If
- Next i
- Next J
- Erase CRR
- r = n
- If n > Rows.Count - 1 Then
- r = Rows.Count - 1
- col = 5
- For i = Rows.Count To n
- k = k + 1
- Crr1(k, 5) = Crr1(i, 4)
- Next i
- End If
-
- Range("C2").Resize(r, col) = Crr1
- Application.ScreenUpdating = True
- MsgBox Format(Timer - t, "0.000秒")
- End Sub
 差集交集并集_天南地北.rar
|