比较 A 列和 B 列的数据一次

Question

I am currently in the process of analysing data from Excel, and would like to make comparisons between data in Column A and Column B, identifying duplicate data. I am using the following code:

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
Set CompareRange = Range("c2", Range("c2").End(xlUp))

For Each x In Selection
    For Each y In CompareRange
        If x = y Then x.Offset(0, 1) = x
    Next y
Next x
End Sub

This code has been taken from MSDN, so if it finds a match in Column C against Column A, it will display the matched number in Column B. For the most part it does what I need. However I am looking to modify this code so it only matches a number in the list once.

Example of what the code currently does:

A2  B2  C2
1   1   1
1   1   2
1   1   3

So essentially, because the number 1 appears once in Column C, Column A keeps finding a match.

What I would like it to do is:

A2  B2  C2
1   1   1
1       2
1       3

So because the number 1 only appears in Column C once, it should only be matched once against the numbers in Column A.

I'm assuming this is probably something simple, but I can't seem to determine the logic. Could someone point me in the right direction please?

Answer 1

Testing for duplicates can be simple or complicated depending on how fast you want your procedure to be and how large the data sets are.

I personally favour the Collection object because it has a unique key and testing for the existence of that key is very fast, especially if the dataset is large. The unique test is done by seeing if the code throws an error when you interrogate the Collection for a particular key. Some are philosophically opposed to testing for errors - I have to say that I'm one, so I actually prefer the Dictionary object but for a task this mundane, I won't go through the steps to reference that.

You'll also see that the code below works with arrays rather than cells on the worksheet itself - again, just a matter of personal taste because it's quicker.

Const SOURCE_COL As String = "A"
Const SOURCE_START_ROW As Long = 2
Const COMPARE_COL As String = "C"
Const COMPARE_START_ROW As Long = 2
Const OUTPUT_COL As String = "B"

Dim ws As Worksheet
Dim sourceValues As Variant
Dim compareValues As Variant
Dim outputValues() As Variant
Dim sourceIndex As Long
Dim compareIndex As Long
Dim uniques As Collection
Dim val As Variant
Dim key As String
Dim exists As Variant

Set ws = ThisWorkbook.Worksheets("Sheet1")
sourceValues = ws.Range(ws.Cells(SOURCE_START_ROW, SOURCE_COL), _
                        ws.Cells(Rows.Count, SOURCE_COL).End(xlUp)).Value2

compareValues = ws.Range(ws.Cells(COMPARE_START_ROW, COMPARE_COL), _
                         ws.Cells(Rows.Count, COMPARE_COL).End(xlUp)).Value2

Set uniques = New Collection
ReDim outputValues(1 To UBound(sourceValues, 1), 1 To 1)

For sourceIndex = 1 To UBound(sourceValues, 1)

    val = sourceValues(sourceIndex, 1)
    key = CStr(val)
    exists = Empty
    On Error Resume Next
    exists = uniques(key)
    On Error GoTo 0

    If IsEmpty(exists) Then

        For compareIndex = 1 To UBound(compareValues, 1)
            If val = compareValues(compareIndex, 1) Then
                outputValues(sourceIndex, 1) = val
                uniques.Add val, key
                Exit For
            End If
        Next

    End If

Next

ws.Cells(SOURCE_START_ROW, OUTPUT_COL).Resize(UBound(outputValues, 1)).Value = outputValues