Question

如果来自Sheet2.Column的Cell.value＆＃34; A＆＃34;在Sheet中没有匹配（＆＃34; Civil＆＃34;）。列＆＃34; A＆＃34;而不是将该单元格复制到表格（＆＃34; Sheet2）.Column＆＃34; D＆＃34;

Correct Results

正确的结果应该看起来像附图，但我有问题写一个正确的代码来填充表格（＆＃34; Sheet2）.Column＆＃34; D＆＃34;

  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 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

VBA Excel匹配复制粘贴如果其他

1 个答案: