Извлечение уникального списка из двух столбцов

Question

Итак, я пытаюсь создать объединенный список из двух отдельных столбцов, опуская дублирующие элементы. Я искал и нашел формулу, которая объединяет список таким образом, проходя через один столбец за раз.

Но я хочу, чтобы объединить столбцы так:

, где он проходит через каждый ряд первых.

Есть ли формула или код VBA, который делает это? Спасибо.

EDIT: Это всего лишь способ показать мою просьбу. Цвет был добавлен, чтобы показать, как отсортированный список сортируется, но не является частью запроса. Фактические списки содержат около 500 строк, состоящих из 9 + цифр идентификационных номеров.

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, выделяя, выбирая дубликаты и т.д.