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

Posted 2023-04-19

【中文标题】VBA Excel匹配复制粘贴如果其他

【英文标题】：VBA Excel match Copy Paste If Else

【发布时间】：2016-07-09 18:19:00

【问题描述】：

如果 Sheet2.Column"A" 中的 Cell.value 在 Sheet("Civil").Column"A" 中不匹配，则将该单元格复制到 Sheets("Sheet2).Column "D"

Correct Results

正确的结果应该如附图所示，但我有问题 编写正确的代码来填充 Sheets("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

【问题讨论】：

这可能超出你的工资标准，但你应该看看Searching values of range X in range Y。

【参考方案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

【讨论】：

完美运行，感谢@Jeeped 在 VBA 编码方面的精彩课程！

有时需要嵌套循环。如果是，请在达到目标后使用Exit For，这样您就不会继续检查更多行。内循环将退出，外循环将从中断处继续。