Question

我看过类似的帖子，但没有任何直接解决我当前问题的内容......

我有一张2张工作簿（Sheet1和Sheet 2）。在Sheet1中，有2列 - 列A包含旧ERP系统的部件号，B列包含重量。在Sheet2中，我有2列 - 列A包含来自我们新ERP系统的部件号，列B包含别名部件号。

我想在Sheet1中的部件号（位于A列中）中读取宏，并查看Sheet2中A列或B列中是否存在该值。如果找到匹配，则需要将相应的权重复制到Sheet2上的C列。

我是编写宏的新手，我已经附加了修改后的代码版本以解决类似的问题。非常感谢任何帮助 - 提前感谢您的任何回复。

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

这可能有助于您入门。我假设您在Sheet1和Sheet2的A列和B列的第1行开始有数据，并且您想要将权重复制到Sheet2中的C列：

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

根据条件将单元格内容复制并粘贴到不同的表格中

1 个答案: