Excel VBA:查找两个重复条目的并集

Question

我是新来的vba，我有两个更新列的文本& &;我想求出这两列的并集

例如:

+---------+---------+

| A | B |

| 1 | 1 |

| 1 | 2 |

| 1 | 3 |

| 2 | 4 |

| 3 | 5 |

| 4 | 6 |

| 4 | 7 |…所以在

我想把结果写在一个新的列a, B, C…列A

• 编号1、1至3
• 编号2,4至4(如果值列A不重复)
• 编号3、5至5
• 编号4、6至7

像这样:

+---------+---------+---------+

| A | B | C |

| 1 | 1 | 3 |

| 2 | 4 | 4 |

| 3 | 5 | 5 |

| 4 | 6 | 7 |

…所以在

这个怎么算?advanced

Answer 1

请使用下一个代码。它将返回列E:F，从第二行开始。

Sub extractMinMax()
Dim sh As Worksheet, lastR As Long, arr, arrIt, arrFin, i As Long, j As Long, dict As New Scripting.Dictionary

Set sh = ActiveSheet 'use here the necessary sheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row

arr = sh.Range("A2:B" & lastR).Value2
'place the range in a dictionay:
For i = 1 To UBound(arr)
If Not dict.Exists(arr(i, 1)) Then
dict.Add arr(i, 1), Array(arr(i, 2))
Else
arrIt = dict(arr(i, 1))
ReDim Preserve arrIt(UBound(arrIt) + 1)
arrIt(UBound(arrIt)) = arr(i, 2)
dict(arr(i, 1)) = arrIt
End If
Next i

'process the dictionary content
ReDim arrFin(1 To dict.count, 1 To 3)
For i = 0 To dict.count - 1
arrFin(i + 1, 1) = dict.Keys()(i)
arrFin(i + 1, 2) = WorksheetFunction.min(dict.Items()(i))
arrFin(i + 1, 3) = WorksheetFunction.Max(dict.Items()(i))
Next i

'drop the processed array content:
sh.Range("E2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value2 = arrFin
End Sub