使用 excel 中的 VB 根据条件在工作表之间复制值

Question

抱歉，我是菜鸟，但我没有足够的时间学习 VB 来解决我的问题。我真的很感激一些帮助，因为我确信有一个简单的修复方法。 我需要将 row7 columnA worksheetA 中的值匹配到行中的值？ columnA worksheetB，然后将 row7 ColumnD worksheetA 中的值复制到行？ ColumnQ 工作表 B.

基本上我有两个工作表，一个是从我们的网上商店导出的，另一个是从我们商店的库存管理系统导出的。我必须将在线商店库存值更改为店内系统显示的实际值。我们在店内销售的商品多于网上销售的商品。但我需要保持在线商店的库存准确无误。两个列表都有大约 2500 行匹配，但一个列表有额外的 2500 行。

我发现以下内容有助于将 row7 columnA sheetA 中的匹配值复制到 row？列Q表B：

Sub UpdateInventory()

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

Application.ScreenUpdating = False

Set w1 = Workbooks("WorksheetA.xlsm").Worksheets("Sheet1")
Set w2 = Workbooks("WorksheetB.xlsm").Worksheets("Sheet1")

For Each c In w1.Range("A7", w1.Range("A" & 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 w2.Range("Q" & FR).Value = c.Offset(, 0)
Next c
Application.ScreenUpdating = True
End Sub

Answer 1

请参阅下面我对 VBA 代码的修改。我在这里添加了一些东西来帮助您诊断代码哪里出错了。我相信它相对简单，我更正的代码的唯一功能部分是：

(a) "FR = Application.Match(c.Value, w2.Columns("A"), 0)"

取代

"FR = Application.Match(c,w2.Columns("A"), 0)"

(b) "w2.Range("Q" & FR).Value = w1.Range("D" & c.Row).Value"=30 =]

取代

"w2.Range("Q" & FR).Value = c.offset(,0)"

我添加了 debug.print 行，您可以在 运行 测试宏后立即监控 window。

Sub UpdateInventory()

Debug.Print "Starting Sub: UpdateInventory"
Debug.Print "-----------------------------"

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long
Dim d As Long
Dim Workbook_A_Name, Workbook_B_Name, Worksheet_A_Name, Worksheet_B_Name As String

Debug.Print "Declared Variables"

'I added in these variable declarations to just neaten things up
Workbook_A_Name = "WorksheetA.xlsm" 'Online-Store File
Workbook_B_Name = "WorksheetB.xlsm" 'In-Store File
Worksheet_A_Name = "Sheet1" 'Online-Store File sheet name
Worksheet_B_Name = "Sheet1" 'In-Store File sheet name

Debug.Print "Set Variables"

Application.ScreenUpdating = False ' Good

Debug.Print "ScreenUpdating Off"

Set w1 = Workbooks(Workbook_A_Name).Worksheets(Worksheet_A_Name)
Set w2 = Workbooks(Workbook_B_Name).Worksheets(Worksheet_B_Name)

Debug.Print "Set Worksheets"

Debug.Print ""

For Each c In w1.Range("A7", w1.Range("A" & Rows.Count).End(xlUp))
    Debug.Print "Doing Line : " & c.AddressLocal & " in workbook: " & w1.Name
    FR = 0
    On Error Resume Next

    FR = Application.Match(c.Value, w2.Columns("A"), 0) 'added ".value" . 'This looks for the appropriate row number in Workbook B to copy data to
    Debug.Print "FR = " & FR
    On Error GoTo 0

    Debug.Print "Copying Matching Data from Column D in Workbook A to Column Q in Workbook B"
    If FR <> 0 Then
        Debug.Print "w2.Range(""Q"" & FR).AddressLocal = " & w2.Range("Q" & FR).AddressLocal
        Debug.Print "w1.Range(""D"" & c.Row).AddressLocal = " & w1.Range("D" & c.Row).AddressLocal
        Debug.Print "w1.Range(""D"" & c.Row).Value = " & w1.Range("D" & c.Row).Value
        w2.Range("Q" & FR).Value = w1.Range("D" & c.Row).Value 'change c.offset(,0)
    End If

Next c

Application.ScreenUpdating = True

Debug.Print "ScreenUpdating Off"

End Sub