返回與VBA中另一列對應的唯一值

Question

我對VBA相對來說比較新，任何幫助解決此問題的幫助都將非常感謝！

我希望Excel查看兩列文本值，並且只返回兩列的唯一值。但是我希望這兩列彼此「對應」，以便返回第一列的唯一值，並且與該列中每個唯一值對應的唯一值將返回到它旁邊。

I.e.如果列如下：

Column 1: a a a d d g g g g 

，第二列的值是

Column 2: 3 3 2 1 1 7 8 8 9 

我想先看看第1列在這裏，第一獨特價值是。然後，取第2列中的所有唯一值（即3和2）。所以（1,1）= a，（1,2）= 3，（2,2）= 2和（2,1）=空。 （3,1）= d，（3,2）= 2，（4,1）=空，（4,2）= 1。則（5,1）= g，（5,2）= 7，（6,1）=空，（6,2）= 8，（7,1）=空，（7,2）= 9 。

解釋有點棘手，但我希望它仍然有可能得到重點！

謝謝！

Answer 1

該代碼會爲你做

Option Explicit 

Sub Main() 

    Dim r1 As Range 
    Set r1 = Application.InputBox(prompt:="Select first range", Type:=8) 

    Dim r2 As Range 
    Set r2 = Application.InputBox(prompt:="Select second range", Type:=8) 

    If r1.Rows.Count <> r2.Rows.Count Then 
     MsgBox "ranges aren't equal in rows, restart the macro!", vbCritical 
     Exit Sub 
    End If 

    ReDim arr(0) As String 
    Dim i As Long 
    For i = 1 To r1.Rows.Count 
     arr(UBound(arr)) = r1.Rows(i) & "###" & r2.Rows(i) 
     ReDim Preserve arr(UBound(arr) + 1) 
    Next i 
    RemoveDuplicate arr 
    ReDim Preserve arr(UBound(arr) - 1) 

    With Sheets(2) 
     .Activate 
     .Columns("A:B").ClearContents 

     For i = LBound(arr) To UBound(arr) 
      .Range("A" & i + 1) = Split(arr(i), "###")(0) 
      .Range("B" & i + 1) = Split(arr(i), "###")(1) 
     Next i 

     For i = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1 
      If StrComp(.Range("A" & i).Offset(-1, 0), .Range("A" & i), vbTextCompare) = 0 Then 
       .Range("A" & i) = vbNullString 
      End If 
     Next i 
    End With 

End Sub 


Sub RemoveDuplicate(ByRef StringArray() As String) 
    Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String 
    If (Not StringArray) = True Then Exit Sub 
    lowBound = LBound(StringArray): UpBound = UBound(StringArray) 
    ReDim tempArray(lowBound To UpBound) 
    cur = lowBound: tempArray(cur) = StringArray(lowBound) 
    For A = lowBound + 1 To UpBound 
     For B = lowBound To cur 
      If LenB(tempArray(B)) = LenB(StringArray(A)) Then 
       If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For 
      End If 
     Next B 
     If B > cur Then cur = B 
    tempArray(cur) = StringArray(A) 
    Next A 
    ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray 
End Sub 

---

會發生什麼事是你被要求用鼠標選擇每列。因此，假設您的電子表格看起來像下圖，然後選擇您需要的兩列。第一欄，然後你會被要求提供第二欄。 （選擇紅色什麼）

重複第二列和您的結果將在Sheet2