Сопоставить уникальные значения с указанным c листом Excel

Question

Мне интересно, возможно ли создать VBA , который сопоставит случайные "числовые коды" из таблицы Excel 2 (скажем, столбец A ) с столбец B (электронная таблица 1).

Некоторые значения в электронной таблице 2 повторяются, Я хотел бы создать уникальное соответствие (нет повторяющихся значений из столбца A / электронной таблицы 2 для моего столбец B / электронная таблица 1)

электронная таблица1 :

электронная таблица2

Требуемый вывод, столбец заполнен значениями Spreadsheet2 ( Unique ):

Возможно ли это? возможно ??

Answer 1

Следующий код VBA использует циклы for для итерации по списку значений в Spreadsheet2 и копирует каждое значение в Spreadsheet1 только в том случае, если значение еще не появилось в списке.

Option Explicit

Sub ListUniqueCodes()

    Dim code As Long
    Dim codes As Range
    Dim i As Integer
    Dim j As Integer
    Dim last_row As Integer
    Dim output_cell As Range
    Dim unique_codes As New Collection  'You could also use a Scripting.Dictionary here as suggested by JvdV
                                        'See https://stackoverflow.com/questions/18799590/avoid-duplicate-values-in-collection

    'Store the length of the list of codes that is in Spreadsheet2:
    last_row = Workbooks("Spreadsheet2.xlsx").Sheets("Sheet1").Range("A1").End(xlDown).Row

    'Store the list of codes that is in Spreadsheet2:
    Set codes = Workbooks("Spreadsheet2.xlsx").Sheets("Sheet1").Range("A1:A" & last_row)

    'For each code...
    For i = 1 To codes.Rows.Count
        code = codes.Cells(i).Value2

        '...if it does not equal zero...
        If code <> 0 Then

            '...and if it is not already in the collection unique_codes...
            For j = 1 To unique_codes.Count
                If unique_codes(j) = code Then Exit For
            Next j

            '...then add it to the collection unique_codes:
            If j = (unique_codes.Count + 1) Then
                unique_codes.Add code
            End If

        End If

    Next i

    Set output_cell = Workbooks("Spreadsheet1.xlsm").Sheets("Sheet1").Range("B2")

    'Write out the unique codes in Spreadsheet1:
    For i = 1 To unique_codes.Count
        output_cell.Offset(i - 1, 0).Value2 = unique_codes(i)
    Next i

End Sub