VBA Excell match Else

Question

Sheet2.Column "A"のCell.valueがSheet（ "Civil"）に一致しない場合、そのセルをSheets（ "Sheet2）.Column"にコピーする "A" 「

Correct Results

正しい結果が添付画像上のようになりますが、私はシート埋めるために正しいコードを書く に問題がある（」シート2）.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

は避けてください第2ループはWorksheetFunctionMATCH functionです。

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