Скопируйте и вставьте содержимое ячейки в другой лист в зависимости от условий

Question

Я видел похожие посты, но ничего, что напрямую касалось моей текущей проблемы ...

У меня есть рабочая тетрадь с 2 листами (Лист 1 и Лист 2). На листе 1 есть 2 столбца - столбец A содержит номера деталей из нашей старой системы ERP, а столбец B содержит веса. В Sheet2 у меня есть 2 столбца - столбец A содержит номера деталей из нашей новой системы ERP, а столбец B содержит номера деталей псевдонимов.

Я бы хотел прочитать макрос в номере детали в Sheet1 (который находится в столбце A) и посмотреть, существует ли это значение в Sheet2 в столбце A или столбце B. Если он найдет совпадение, ему потребуется скопируйте соответствующий вес в столбец C на листе 2.

Я новичок в написании макросов, и я прикрепил измененную версию кода, опубликованную к аналогичной проблеме. Любая помощь будет принята с благодарностью - заранее благодарю за любые ответы.

Sub CopyCells()

    Application.ScreenUpdating = False

    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long

    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")

    lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
    lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastrow1
        For j = 2 To lastrow2
            If sh1.Cells(i, "A").Value = sh2.Cells(j, "A").Value Or _
                sh1.Cells(i, "A").Value = sh2.Cells(j, "B").Value Then

                sh1.Cells(i, "B").Value = sh2.Cells(j, "C").Value
            End If
        Next j
    Next i

    Application.ScreenUpdating = True

End Sub

Answer 1

Это может помочь вам начать. Я предполагаю, что у вас есть данные, начинающиеся со строки 1 в столбцах A и B Sheet1 и Sheet2, и вы хотите скопировать веса в столбец C в Sheet2:

Sub GetMatches()

    Dim PartRngSheet1 As Range, PartRngSheet2 As Range
    Dim lastRowSheet1 As Long, lastRowSheet2 As Long
    Dim cl As Range, rng As Range

    lastRowSheet1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
    Set PartRngSheet1 = Worksheets("Sheet1").Range("A1:A" & lastRowSheet1) 

    lastRowSheet2 = Worksheets("Sheet2").Range("B65536").End(xlUp).Row
    Set PartRngSheet2 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet2)

    For Each cl In PartRngSheet1
        For Each rng In PartRngSheet2
            If (cl = rng) Or (cl = rng.Offset(0, 1)) Then
                rng.Offset(0, 2) = cl.Offset(0, 1)
            End If 
        Next rng
    Next cl
End Sub