Excel VBA 对比同工作表两列并复制A列不匹配行到新工作表

原代码问题梳理 #

• 对比范围错误：原代码中rng2设置为B列起始范围，不符合需求中对比D列的要求
• 匹配逻辑倒置：原代码判断匹配成功才复制内容，我们需要的是A列中未在D列找到匹配值的内容才复制
• 复制范围不符合要求：原代码复制整行，需求仅需复制对应行的A、B两列
• 行号变量类型风险：用Integer存储行号最多支持32767行数据，数据量较大时会溢出，建议改用Long类型

修正后代码 #

Sub 提取A列D列不匹配内容()
    Dim CopyToRow As Long
    Dim rngA As Range ' A列待对比范围
    Dim rngD As Range ' D列对比基准范围
    Dim cell As Range
    Dim found As Range
    
    ' 初始化目标表写入起始行，从第2行开始写（留表头）
    CopyToRow = 2
    
    ' 定义对比范围，根据实际表头位置调整，这里假设A列、D列均从第2行开始有有效数据
    With ActiveSheet
        Set rngA = .Range(.Cells(2, "A"), .Cells(2, "A").End(xlDown))
        Set rngD = .Range(.Cells(2, "D"), .Cells(2, "D").End(xlDown))
    End With
    
    ' 遍历A列每个值
    For Each cell In rngA
        ' 在D列查找是否有完全匹配的值
        Set found = rngD.Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        
        ' 没找到匹配值的情况下，复制当前行A、B列到Sheet2
        If found Is Nothing Then
            Range(cell.Offset(0, 0), cell.Offset(0, 1)).Copy Destination:=Sheets("Sheet2").Range("A" & CopyToRow)
            CopyToRow = CopyToRow + 1
        End If
    Next cell
End Sub

注意事项 #

• 如果你的D列数据起始行不是第2行，自行修改rngD定义里的行号参数即可
• 运行前确保目标工作表Sheet2已经存在，否则会触发报错
• 若需要保留原表的单元格格式，可把复制语句替换为带格式粘贴的写法

内容的提问来源于stack exchange，提问作者TropicalMagic