VBA проверяет, присутствуют ли значения из одного столбца в другом, и если да, переносит связанные данные

Question

Код, который я имею (ниже), выполняет работу в определенной степени. У меня вопрос, как мне получить данные в столбцах B, C и D, чтобы соответствовать передаче в Tab1.

В данный момент код просматривает значения в столбце A на вкладке Tab0, затем проверяет, присутствуют ли какие-либо из них в столбце A на вкладке 1, и, если их нет, добавляет их внизу.

Мой текущий код:

Sub MovenMatch()

Dim varfirst1 As Range, varsecond2 As Range
Dim n&, m&
Dim first1 As Range, second2 As Range
Dim rowCount1&, rowCount2&
Dim mFlag As Boolean

rowCount1 = Sheets("Tab0").Cells(Sheets("Tab0").Rows.Count, "A").End(xlUp).Row
rowCount2 = Sheets("Tab1").Cells(Sheets("Tab1").Rows.Count, "A").End(xlUp).Row

Set varfirst1 = Sheets("Tab0").Range("A2:A" & rowCount1)
Set varsecond2 = Sheets("Tab1").Range("A2:A" & rowCount2)
m = rowCount2 + 1

For Each first1 In varfirst1
    mFlag = False
    For Each second2 In varsecond2
        If CStr(first1) = CStr(second2) Then
            mFlag = True
            Exit For
        End If
    Next second2

    If mFlag = False Then
        Sheets("Tab1").Range("A" & m).Value = first1

'Я предполагаю, что исправление должно появиться здесь, заменив "xyz":

    Sheets("Tab1").Range("B" & m).Value = "xyz"


    m = m + 1
End If

Next first1
End Sub

Answer 1

Коллекции идеально подходят для сопоставления уникальных идентификаторов. Мой код хранит ссылки на ячейки вместе с уникальными идентификаторами для упрощения задач.

Sub MovenMatch2()
    Dim cell As Range, dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Tab1")
        For Each cell In .Range("A2", .Range("A" & .Rows.count).End(xlUp))
            Set dict(cell.Value) = cell
        Next
    End With

    With ThisWorkbook.Worksheets("Tab0")
        For Each cell In .Range("A2", .Range("A" & .Rows.count).End(xlUp))
            If dict.Exists(cell.Value) Then
                dict(cell.Value).Resize(1, 4).Value = cell.Resize(1, 4).Value
            Else
                With ThisWorkbook.Worksheets("Tab1")
                    .Range("A" & .Rows.count).End(xlUp).Offset(1).Resize(1, 4).Value = cell.Resize(1, 4).Value
                End With
            End If
        Next
    End With

End Sub