返回与VBA中另一列对应的唯一值

Question

我对VBA比较陌生，任何帮助解决这个问题的人都会非常感激！

我希望Excel查看两列文本值，并且只返回两列的唯一值。但我希望这两列能够对应＆＃34;彼此之间，以便返回第一列的唯一值，并且在该列旁边返回与该列中的每个唯一值对应的唯一值。

即。如果列如下：

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

第二列的值是

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

我想先看一下第1列。这里，第一个唯一值是a。然后，获取第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

中重新打印