1

我对 VBA 比较陌生，任何帮助解决这个问题都将不胜感激！

我希望 Excel 查看两列文本值，并且只返回两列的唯一值。但我希望两列相互“对应”，以便返回第一列的唯一值，并在其旁边返回与该列中每个唯一值对应的唯一值。

即，如果列如下：

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)=empty 和 (4,2)=1。那么 (5,1)=g, (5,2)=7, (6,1)=empty, (6,2)=8, (7,1)=empty, (7,2)=9 .

解释起来有点棘手，但我希望仍然可以得到重点！

谢谢！

4

1 回答 1

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

在此处输入图像描述

于 2013-10-22T14:09:57.950 回答