VBA Excell匹配复制粘贴如果否则

如果来自Sheet2.Column“A”的Cell.value在Sheet（“Civil”）。Column A中不匹配，则将该单元格复制到Sheets（“Sheet2）.Column”D“

正确的结果

正确的结果应该看起来像附加的图片，但我有问题写一个正确的代码来填补表格（“Sheet2）.Column”D“

Sub NewSearch_A() Dim cell As Range, rng As Range, rng2 As Range, rng3 As Range, cell1 As Range, n As Integer, m As Integer Set rng = Sheets("Civil").Range("A2:A1000") Set rng2 = Sheets("Sheet2").Range("A1:A100") Set rng3 = Sheets("Sheet2").Range("C1:C100") Set rng4 = Sheets("Sheet2").Range("D1:D100") n = 1 m = 1 For Each cell In rng n = n + 1 For Each cell1 In rng2 m = m + 1 If cell.Value = cell1.Value Then Sheets("Sheet2").Range("C" & m & ":C" & m).Value = Sheets("Civil").Range("B" & n & ":B" & n).Value Else ' ???????????????????????????????????????????????? End If Next cell1 m = 1 Next cell ActiveSheet.Columns("A:C").AutoFit End Sub 

Answer 1

使用WorksheetFunction MATCH函数避免第二个循环。

 Sub NewSearch_A() Dim rw As Long, mtch As Variant, wsc As Worksheet Set wsc = Worksheets("Civil") With Worksheets("Sheet2") For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row mtch = Application.Match(.Cells(rw, "A").Value2, wsc.Columns("A"), 0) If IsError(mtch) Then .Cells(rw, "D") = .Cells(rw, "A").Value2 Else .Cells(rw, "C") = wsc.Cells(mtch, "B").Value2 End If Next rw End With End Sub