Question

请帮助我..

我有两个工作簿Bookone.xlsm和Booktwo.xlsm，bookone将是源，booktwo是目标excel文件。

Bookone和Booktwo具有以下数据。 Source and target excel file snapshot

我只需更新空的单元格，但所有单元格都会更新，包括非空单元格

输出我的VBA脚本。 Output

提前致谢.. :)

我的代码：

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

End Sub

Answer 1

您正在w1列D中的w2列A搜索值。除了＆＃34; Mach7＆＃34;外，还会找到所有值。所以所有值都会更新。

如果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是否为错误值。

excel vba宏来匹配来自两个不同工作簿的单元格并相应地复制和粘贴，并且必须仅更新空单元格

1 个答案: