VBA - 如果行不存在，则根据 A 列和 C 列将行从工作表 X 复制到工作表 Y

如何解决VBA - 如果行不存在，则根据 A 列和 C 列将行从工作表 X 复制到工作表 Y

我现在正在尝试执行此代码一段时间，但到目前为止还没有成功。根据 A 列和 C 列中数据的比较，如果工作表 Y 中尚不存在行，我想将工作表 X 中的行复制到另一工作表 Y 的末尾。

当我只需要与一列进行比较时，我已经完成了代码，并且它运行良好。我把它放在那里，所以你可以看到：

sourceLastRow = ws_src.Cells(ws_src.Rows.Count,"A").End(xlUp).Offset(1).Row
destLastRow = ws_dest.Cells(ws_dest.Rows.Count,"A").End(xlUp).Offset(1).Row

    For Each rng In ws_src.Range("A2:A" & sourceLastRow)
        Set foundVal = ws_dest.Range("A2:A" & destLastRow).Find(rng,LookIn:=xlValues,lookat:=xlWhole)
        
        If foundVal Is nothing Then

            rng.EntireRow.copy
            ws_dest.Cells(Rows.Count,"A").End(xlUp).Offset(1,0).PasteSpecial xlPasteValues
              
        End If
    Next rng

不幸的是，当我尝试比较两列时，我没有得到我需要的结果。我尝试了下面的代码，但它没有停止就复制了我第一张纸的第一行：

Dim ws_src As Worksheet
Dim ws_dest As Worksheet

Dim rw_src As Range
Dim rw_dest As Range

Set ws_src = Worksheets(1)
Set ws_dest = Worksheets(2)

For Each rw_src In ws_src.Rows

    For Each rw_dest In ws_dest.Rows
        If ws_src.Cells(rw_src.row,1).Value = ws_dest.Cells(rw_dest.row,1).Value And ws_src.Cells(rw_src.row,3).Value = ws_dest.Cells(rw_dest.row,3).Value Then
        Else: rw_src.EntireRow.copy
            ws_dest.Cells(Rows.Count,0).PasteSpecial xlPasteValues
        End If
    Next rw_dest
Next rw_src

感谢您的时间！

莉亚

解决方法

这是您正在尝试的吗（未经测试）？

Option Explicit

Sub Sample()
    Dim ws_src As Worksheet
    Dim ws_dest As Worksheet
    
    '~~> Change as applicable
    Set ws_src = Sheet1
    Set ws_dest = Sheet2
    
    Dim lRow As Long
    Dim i As Long
    
    '~~> Find Last row in ws_src
    With ws_src
        .AutoFilterMode = False
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
    
    Dim rngToCopy As Range,FilteredRange As Range
    Dim NewRow As Long
    
    With ws_dest
        '~~> Find Last row in ws_dest
        NewRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To lRow
            .AutoFilterMode = False
            
            '~~> Put the filters
            .Range("A1:C" & NewRow).AutoFilter Field:=1,Criteria1:="=" & ws_src.Cells(i,1).Value2
            .Range("A1:C" & NewRow).AutoFilter Field:=3,3).Value2

            Set FilteredRange = .Range("A1:C" & NewRow).Offset(1,0).SpecialCells(xlCellTypeVisible).EntireRow
            
            '~~> If no match found then store the row in an object
            If Application.CountA(FilteredRange) = 0 Then
                If rngToCopy Is Nothing Then
                    Set rngToCopy = ws_src.Rows(i)
                Else
                    Set rngToCopy = Union(rngToCopy,ws_src.Rows(i))
                End If
            Else
                Set FilteredRange = Nothing
            End If
        Next i
        .AutoFilterMode = False
    End With
    
    '~~> Do the copy in one go
    If Not rngToCopy Is Nothing Then rngToCopy.Copy ws_dest.Rows(NewRow + 1)
End Sub

重要提示：无论您采用哪种方法，无论是 .Find 还是 .Autofilter 或其他任何方法，都不要在循环中复制和粘贴。会很慢。最后复制如上图。

,

这是您正在寻找的简单示例。修改代码以满足您的需求并尝试：

Option Explicit

Sub test()
    
    Dim wsSource As Worksheet,wsDestination As Worksheet
    Dim LastRowSource As Long,LastRowDestination As Long
    Dim i As Long,y As Long
    Dim Value_1 As String,Value_2 As String
    Dim ValueExists As Boolean
    
    With ThisWorkbook
        Set wsSource = .Worksheets("Sheet1")
        Set wsDestination = .Worksheets("Sheet2")
    End With
    
    With wsSource
    
        'Find the last row of Column A,wsSource
        LastRowSource = .Cells(.Rows.Count,"A").End(xlUp).Row
        
        'Loop Column A,wsSource
        For i = 1 To LastRowSource
        
            'Let's say we are testing Columns A & B
            Value_1 = .Range("A" & i).Value
            Value_2 = .Range("B" & i).Value
            
            ValueExists = False
            
            With wsDestination
            
                'Find the last row of Column A,wsDestination
                LastRowDestination = .Cells(.Rows.Count,"A").End(xlUp).Row
                
                'Loop Column A,wsDestination
                For y = 1 To LastRowDestination
                
                    If .Range("A" & y).Value = Value_1 And .Range("B" & y).Value = Value_2 Then
                        ValueExists = True
                        Exit For
                    End If
                    
                Next y
                
                'if value does not exist copy
                If ValueExists = False Then
                    .Range("A" & LastRowDestination + 1).Value = Value_1
                    .Range("B" & LastRowDestination + 1).Value = Value_2
                End If
                
            End With
            
        Next i
        
    End With
    
End Sub