Question

我正在寻找一个VBA脚本，它将工作簿1上的列D与工作簿2上的列A进行比较。如果匹配，我希望将workbook2列G中的数据复制到woksbook1列E中。

我找到了这个脚本：

Sub UpdateW2()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long

Application.ScreenUpdating = False

Set w1 = Workbooks("Excel VBA Test.xlsm").Worksheets("Blad1")
Set w2 = Workbooks("Excel VBA Test Backbone.xlsx").Worksheets("Blad1")

For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
    FR = 0
    On Error Resume Next
    FR = Application.Match(c, w2.Columns("A"), 0)
    On Error GoTo 0
    If FR <> 0 Then w1.Range("C" & FR).Value = c.Offset(, -3)
Next c
Application.ScreenUpdating = True
End Sub

它很简单，几乎可以做我想要的但是进入错误的工作表。我没有设法切换哪个工作表来复制数据。任何帮助都会有所帮助。

Answer 1

这就是你需要的吗？认为你是在错误的方式复制，你的偏移量是不对的。

Sub UpdateW2()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Variant

Application.ScreenUpdating = False

Set w1 = Workbooks("Excel VBA Test.xlsm").Worksheets("Blad1")
Set w2 = Workbooks("Excel VBA Test Backbone.xlsx").Worksheets("Blad1")

For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
    FR = Application.Match(c, w2.Columns("A"), 0)
    If IsNumeric(FR) Then c.Offset(, 1).Value = w2.Range("G" & FR).Value
Next c

Application.ScreenUpdating = True

End Sub

Excel VBA比较两个工作簿中的值然后复制数据

1 个答案: