返回与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