從兩列中提取獨特的不同列表

Question

所以我想通過省略重複的項目從兩個單獨的列創建組合列表。我已經搜索並找到了一種公式，它通過一次一頁地瀏覽列表來結合列表。

但我想列組合在一起就像這樣：

在那裏經過的每一行第一。

是否有一個公式或VBA代碼來做到這一點？謝謝。

編輯：這只是一種方式來顯示我的請求。添加顏色以顯示組合列表如何排序，它不是請求的一部分。實際列表每個大約500行，包含9位以上的數字ID號碼。

Answer 1

這將把你想要的順序的獨特的話。

Sub foo() 
Dim rng As Range 
Dim ws As Worksheet 
Dim i&, j&, t& 
Dim dict As Object 
Dim iArr() As Variant 
Dim oarr() As Variant 
Dim itm As Variant 
Set dict = CreateObject("Scripting.Dictionary") 

Set ws = ActiveSheet 
With ws 
    Set rng = .Range("A:B").Find("*", .Range("A1"), , , , xlPrevious) 
    If Not rng Is Nothing Then 
     iArr = .Range(.Cells(2, 1), .Cells(rng.Row, 2)).Value 
     For i = LBound(iArr, 1) To UBound(iArr, 1) 
      For j = LBound(iArr, 2) To UBound(iArr, 2) 
       If iArr(i, j) <> "" Then 
        On Error Resume Next 
        dict.Add iArr(i, j), iArr(i, j) 
        On Error GoTo 0 
       End If 
      Next j 
     Next i 
    End If 

    'If your dataset is not that large <30,000, then you can use it directly with transpose 
    .Range("C2").Resize(dict.Count) = Application.Transpose(dict.items) 
    'If your data is large then you will want to put it in a one dimensional array first 
    'just uncomment the below and comment the one line above 
' ReDim oarr(1 To dict.Count, 1 To 1) 
' t = 1 
' For Each itm In dict.keys 
'  oarr(t, 1) = dict(itm) 
'  t = t + 1 
' Next itm 
' Range("C2").Resize(dict.Count) = oarr 
End With 
End Sub 

Answer 2

UDF解決方案。使用您提供的樣本數據，把這個公式在單元格I2抄下=UnqList(ROW(I1),$G$2:$H$6)或=UnqList(ROW(I1),$G$2:$G$6,$H$2:$H$6)（它可以是因爲兩個或多個列表可能不是彼此相鄰和UDF佔該）

Public Function UnqList(ByVal lIndex As Long, ParamArray rLists() As Variant) As Variant 

    Dim i As Long, j As Long 
    Dim vList As Variant 
    Dim cUnq As Collection 
    Dim lMaxRow As Long, lMaxCol As Long 

    If lIndex <= 0 Then 
     UnqList = CVErr(xlErrRef) 
     Exit Function 
    End If 

    For Each vList In rLists 
     If TypeName(vList) <> "Range" Then 
      UnqList = CVErr(xlErrRef) 
      Exit Function 
     Else 
      If vList.Rows.Count > lMaxRow Then lMaxRow = vList.Rows.Count 
      If vList.Columns.Count > lMaxCol Then lMaxCol = vList.Columns.Count 
     End If 
    Next vList 

    Set cUnq = New Collection 

    For i = 1 To lMaxRow 
     For j = 1 To lMaxCol 
      For Each vList In rLists 
       If i <= vList.Rows.Count And j <= vList.Columns.Count Then 
        On Error Resume Next 
        cUnq.Add vList.Cells(i, j).Value, CStr(vList.Cells(i, j).Value) 
        On Error GoTo 0 
        If lIndex = cUnq.Count Then 
         UnqList = cUnq(cUnq.Count) 
         Set cUnq = Nothing 
         Exit Function 
        End If 
       End If 
      Next vList 
     Next j 
    Next i 

    UnqList = CVErr(xlErrRef) 
    Set cUnq = Nothing 

End Function 

Answer 3

您可以使用我的Duplicate Master插件通過我的個人資料。

優點是，插件提供的選項用於

• 忽略capitilisation
• 忽略空白
• 運行RegExp置換（高級）
• 爲deletinf進一步選擇，突出顯示，選擇重複等