Vba 在excel中匹配和插入记录

我有两张数据表。一张工作表的主Id有4个字段，另一张工作表的主Id有2个字段

          Sheet A                                         Sheet B
ID    Name    Price   Type    Category              ID      Name     Price
1                      S        Normal              2       Aus       500
2                      N        Default             1       Ind       400

基本上，我需要匹配两张表的ID，并在A表和B表中复制相应的名称和价格。我尝试了以下代码

Sub Copy()

lastrowA = Worksheets("SheetA").Cells(Rows.Count, "A").End(xlUp).Row + 1
Set rngA = Range("A2" & lastrowA)
lastrowB = Worksheets("SheetB").Cells(Rows.Count, "A").End(xlUp).Row + 1
Set rngB = Range("A2" & lastrowB)
For Each x In rngB
    For Each y In rngA
        If x.Value() = y.Value Then
           ' Copy paste name and price form B to A
        End If
    Next
Next

End Sub

---

是否必须在不使用公式的情况下进行？我不确定我是否遗漏了什么，但您可以使用

Vlookup

或

索引

匹配

如果从VBA输入公式：

Cells(2,2).FormulaR1C1 = "=INDEX(Sheet2!R2C2:R3C3,MATCH(RC[-1],Sheet2!RC[-1]:R[1]C[-1],0),1)"
Cells(2,3).FormulaR1C1 = "=INDEX(Sheet2!R2C2:R3C3,MATCH(RC[-2],Sheet2!R2C1:R3C1,0),2)"

然后，您可以在第1页的ID列中找到最后一行，并在两列中填写公式。填写完公式后，只需复制并粘贴为值即可

Dim lstRow As Long
lstRow = Sheets("Sheet 1").Cells(Rows.Count, 1).End(xlUp).Row '' find last row
Range(Cells(2, 2), Cells(lstRow, 3)).FillDown
Range(Cells(2, 2), Cells(lstRow, 3)).Copy
Cells(2, 2).PasteSpecial Paste:=xlPasteValues 

---

编辑：您可以在VBA公式中使用

lstRow

变量，以确保每次运行自动化时公式覆盖整个范围。如果您不喜欢自己创建公式，可以使用excel中的“录制宏”按钮获取公式代码。

是否必须在不使用公式的情况下完成？我不确定我是否遗漏了什么，但您可以使用

Vlookup

或

索引

匹配

如果从VBA输入公式：

Cells(2,2).FormulaR1C1 = "=INDEX(Sheet2!R2C2:R3C3,MATCH(RC[-1],Sheet2!RC[-1]:R[1]C[-1],0),1)"
Cells(2,3).FormulaR1C1 = "=INDEX(Sheet2!R2C2:R3C3,MATCH(RC[-2],Sheet2!R2C1:R3C1,0),2)"

然后，您可以在第1页的ID列中找到最后一行，并在两列中填写公式。填写完公式后，只需复制并粘贴为值即可

Dim lstRow As Long
lstRow = Sheets("Sheet 1").Cells(Rows.Count, 1).End(xlUp).Row '' find last row
Range(Cells(2, 2), Cells(lstRow, 3)).FillDown
Range(Cells(2, 2), Cells(lstRow, 3)).Copy
Cells(2, 2).PasteSpecial Paste:=xlPasteValues 

---

编辑：您可以在VBA公式中使用

lstRow

变量，以确保每次运行自动化时公式覆盖整个范围。如果您不喜欢自己创建公式，可以使用excel中的“录制宏”按钮获取公式代码。

代码的问题在于

Set rngA = Range("A2" & lastrowA)

对于lastRowA=5，计算范围为（“A25”）。
如果要寻址多个单元格，请使用

Set rngA = Range("A2:A" & lastrowA)

获取lastRowA=5的范围（“A2:A5”）

---

除此之外，前面提到的公式也是一个优雅的解决方案。

代码的问题是

Set rngA = Range("A2" & lastrowA)

对于lastRowA=5，计算范围为（“A25”）。
如果要寻址多个单元格，请使用

Set rngA = Range("A2:A" & lastrowA)

获取lastRowA=5的范围（“A2:A5”）

---

除此之外，前面提到的公式也是一个优雅的解决方案。

使用保留字作为宏的名称从来都不是一个好主意。如果计划在宏中使用

.Copy

操作，则尤其如此

Sub MyCopy()
    Dim lastrowA As Long

    With Worksheets("SheetA")
        lastrowA = .Cells(Rows.Count, "A").End(xlUp).Row
        With .Range("B2:C" & lastrowA)
            .Formula = "=IFERROR(VLOOKUP($A2, 'SheetB'!$A:$C, COLUMN(B:B), FALSE), """")"
            .Value = .Value
        End With
    End With

End Sub

---

该批量使用适当的公式填充整个区域，而不进行循环，然后将返回的值转换为原始值。任何不匹配项都将为空，而不是

#N/A

错误。

使用保留字作为宏的名称从来都不是一个好主意。如果计划在宏中使用

.Copy

操作，则尤其如此

Sub MyCopy()
    Dim lastrowA As Long

    With Worksheets("SheetA")
        lastrowA = .Cells(Rows.Count, "A").End(xlUp).Row
        With .Range("B2:C" & lastrowA)
            .Formula = "=IFERROR(VLOOKUP($A2, 'SheetB'!$A:$C, COLUMN(B:B), FALSE), """")"
            .Value = .Value
        End With
    End With

End Sub

---

该批量使用适当的公式填充整个区域，而不进行循环，然后将返回的值转换为原始值。任何不匹配项都将为空，而不是

#N/A

错误。

为什么选择VBA？一张简单的A表！B2 like

=VLOOKUP（$A2，‘表B’！$A:$C，列（B:B），FALSE）

。请在一列右下任意填充。我正在自动执行任务，因此需要使用VBASo使用

WorksheetFunction.Vlookup（…）

。为什么使用VBA？一张简单的A表！B2 like

=VLOOKUP（$A2，‘表B’！$A:$C，列（B:B），FALSE）

。请在右边的一列中填入您喜欢的内容。我正在自动执行任务，因此需要使用VBASo使用

工作表函数.Vlookup（…）

。