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的其他选项，突出显示，选择重复项等

从两列中提取唯一的不同列表

3 个答案: