vba 根据条件将单元格内容复制并粘贴到不同的工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/4586811/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copy and Paste Cell Contents to Different Sheet Based on Condition
提问by anticedent
I've seen similar posts, but nothing that has directly addressed my current problem...
我看过类似的帖子，但没有直接解决我当前的问题......
I have a workbook with 2 sheets (Sheet1 and Sheet 2). In Sheet1, there are 2 columns - column A contains part numbers from our old ERP system and column B contains weights. In Sheet2, I have 2 columns - column A contains part numbers from our new ERP system and column B contains alias part numbers.
我有 2 张工作簿（Sheet1 和 Sheet 2）。在 Sheet1 中，有 2 列 - A 列包含来自我们旧 ERP 系统的零件号，B 列包含重量。在 Sheet2 中，我有 2 列 - A 列包含来自我们新 ERP 系统的部件号，B 列包含别名部件号。
I would like to have a macro read in the part number in Sheet1 (which sits in column A) and see if that value exists in Sheet2 in either column A or column B. If it finds a match, it would need to copy the corresponding weight to column C on Sheet2.
我想在 Sheet1（位于 A 列中）的部件号中读取一个宏，并查看该值是否存在于 Sheet2 中的 A 列或 B 列中。如果找到匹配项，则需要复制相应的重量到 Sheet2 上的 C 列。
I am a novice at writing macros and I've attached a modified version of code posted to a similar problem. Any help would be greatly appreciated - thank you in advance to any replies.
我是编写宏的新手，我已经附上了发布到类似问题的代码的修改版本。任何帮助将不胜感激 - 提前感谢您的任何答复。
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
采纳答案by Alex P
This might help get you started. I am assuming you have data starting in row 1 in columns A and B of Sheet1 and Sheet2 and that you want to copy weights to Column C in Sheet2 :
这可能有助于您入门。我假设您的数据从 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
