excel vba宏，以匹配來自兩個不同工作簿的單元格，並相應地進行復制和粘貼，並且只需要更新空白單元格

Question

請幫助我。

我有兩個工作簿Bookone.xlsm和Booktwo.xlsm，bookone是源文件，booktwo是目標excel文件。

Bookone和Booktwo具有以下數據。 源和目標Excel文件快照

我只需要更新里面是空的細胞，但所有的細胞都得到了更新，包括非空單元格

我的VBA腳本的輸出。 輸出量

提前致謝.. ：）

我的代碼：

Sub UpdateW2()

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

Application.ScreenUpdating = False

Set w1 = Workbooks("BookOne.xlsm").Worksheets("Sheet1")
Set w2 = Workbooks("BookTwo.xlsm").Worksheets("Sheet1")


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 w2.Range("C" & FR).Value = c.Offset(, -3)
    If FR <> 0 Then w2.Range("C" & FR).Value.Interior.ColorIndex=8
Next c
Application.ScreenUpdating = True

結束子

Answer 1

您正在w2列A w1列D中搜索值。 除了“ Mach7”，將找到所有值。 因此， 所有值將被更新。

如果w2列C仍然為空，則可能只需要更新。 然后，您必須檢查一下。

Sub UpdateW2()

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

 Application.ScreenUpdating = False

 Set w1 = Workbooks("BookOne.xlsm").Worksheets("Sheet1")
 Set w2 = Workbooks("BookTwo.xlsm").Worksheets("Sheet1")

 For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
  FR = Empty
  FR = Application.Match(c, w2.Columns("A"), 0)
  If TypeName(FR) <> "Error" Then 'match was found
   If IsEmpty(w2.Range("C" & FR)) Then 'cell in w2 is still empty
    w2.Range("C" & FR).Value = c.Offset(, -3)
    w2.Range("C" & FR).Interior.ColorIndex = 8
   End If
  End If
 Next c

 Application.ScreenUpdating = True

End Sub

與WorksheetFunction.Match相反，如果未找到匹配項， Application.Match將不會引發錯誤。 相反，它將返回一個錯誤值。 因此，沒有On Error...在這里，如果你需要DIM的FR的Variant 。 然后可以檢查FR是否為錯誤值。