從兩列中提取唯一的不同列表

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插件。

優點是addin提供了選項

• 忽視資本化
• 忽略空格
• 運行RegExp替換（高級）
• deletinf的其他選項，突出顯示，選擇重復項等