2つの列から一意の個別リストを抽出する

Question

したがって、重複する項目を省略して2つの別々の列から結合リストを作成しようとしています。私は検索し、一度に1つの列を通過するこの方法でリストを結合する数式を発見しました。

しかし、私はこのような列を結合したい：それは最初の各行をどこに行く

を。

これを実行する式または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ソリューション。 は（二つ以上のリストが互いにそのためのUDFのアカウントの隣ではないかもしれないので、それがいずれかになります）

ご提供されているサンプルデータを使用して、セルI2にこの数式を入れて、 =UnqList(ROW(I1),$G$2:$H$6)または =UnqList(ROW(I1),$G$2:$G$6,$H$2:$H$6)を下にコピー

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アドインを私のプロフィールで利用することができます。

利点は、アドインが

• にオプションを提供することである
• は空白
• ランRegExp置換重複など

を選択強調deletinf用（高度）

さらにオプションを無視capitilisationを無視