基于列

Question

我尝试创建一个在比较列值后复制数据行的宏。我之前问过这个问题question，但取得了一些进展，并且如果我发布另一个问题，我认为这不会让人感到困惑。要比较的列是＆＃34; eRequest ID＆＃34;它由整数和文本组成。

我有两个工作表，都带有＆＃34; eRequest ID＆＃34;作为第一列。这里的目标是复制 ANY 数据行，这些数据行具有＆＃34; eRequest ID＆＃34;两个工作表中的 NOT FOUND 。这意味着该记录是什么＆＃34; eRequest ID＆＃34;只能在一个工作表上找到，而不是两者都有，整行数据必须复制到第三个新工作表中。

我在浏览网络后，并在编码专家的帮助下制定了一些代码。这段代码的问题在于，我得到了一个＆＃34;不匹配＆＃34;对于每一行。我尝试在此处更改foundTrue值，但它似乎无法正常工作。我需要它只复制工作表上只有 1＆＃34; eRequest ID＆＃34; 的数据行。非常感谢任何帮助，感谢您的努力！

Sub compareAndCopy()

Dim lastRowE As Integer
Dim lastRowF As Integer 
Dim lastRowM As Integer
Dim foundTrue As Boolean

Application.ScreenUpdating = False

lastRowE = Sheets("JULY15Release_Master Inventory").Cells(Sheets("JULY15Release_Master Inventory").Rows.Count, "A").End(xlUp).Row
lastRowF = Sheets("JULY15Release_Dev status").Cells(Sheets("JULY15Release_Dev status").Rows.Count, "A").End(xlUp).Row
lastRowM = Sheets("Mismatch").Cells(Sheets("Mismatch").Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRowE
foundTrue = True
For j = 1 To lastRowF

'If Sheets("JULY15Release_Master Inventory").Cells(i, 2).Value = Sheets("JULY15Release_Dev status").Cells(j, 7).Value Then
 If Sheets("JULY15Release_Master Inventory").Cells(i, 2).Value <> Sheets("JULY15Release_Dev status").Cells(j, 7).Value Then
    foundTrue = False
    Exit For
End If

Next j

If foundTrue Then
Sheets("JULY15Release_Dev status").Rows(i).Copy Destination:= _
Sheets("Mismatch").Rows(lastRowM + 1)
lastRowM = lastRowM + 1

End If


Next i

Application.ScreenUpdating = False

End Sub

Answer 1

试试这个，它应该可行， TESTED 。

Sub test()

Dim lrow1 As Long
Dim lrow2 As Long
Dim i As Long
Dim K As Long
Dim j As Long
Dim p As Variant
Dim wb As Workbook

Set wb = ThisWorkbook
K = 2
lrow1 = wb.Sheets("JULY15Release_Master Inventory").Range("A" & Rows.Count).End(xlUp).Row
lrow2 = wb.Sheets("JULY15Release_Dev status").Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lrow1

p = Application.Match(wb.Sheets("JULY15Release_Master Inventory").Range("A" & i).Value, wb.Sheets("JULY15Release_Dev status").Range("A1" & ":" & "A" & lrow2), 0)
If IsError(p) Then
        wb.Sheets("JULY15Release_Master Inventory").Rows(i).Copy Destination:=Sheets("Mismatch").Rows(K)
        K = K + 1
End If
Next

For j = 1 To lrow2
p = Application.Match(wb.Sheets("JULY15Release_Dev status").Range("A" & j).Value, wb.Sheets("JULY15Release_Master Inventory").Range("A1" & ":" & "A" & lrow1), 0)
If IsError(p) Then
        wb.Sheets("JULY15Release_Dev status").Rows(j).Copy Destination:=Sheets("Mismatch").Rows(K)
        K = K + 1
End If
Next
End Sub

Answer 2

另一个变种

    Sub test()
    Dim lastRowE&, lastRowF&, lastRowM&, Key As Variant
    Dim Cle As Range, Clf As Range
    Dim DicInv As Object: Set DicInv = CreateObject("Scripting.Dictionary")
    Dim DicDev As Object: Set DicDev = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = 0

    lastRowE = Sheets("JULY15Release_Master Inventory").Cells(Rows.Count, "A").End(xlUp).Row
    lastRowF = Sheets("JULY15Release_Dev status").Cells(Rows.Count, "A").End(xlUp).Row
    lastRowM = Sheets("Mismatch").Cells(Rows.Count, "A").End(xlUp).Row

    'add into dictionary row number from Inventory where cell is matched
    For Each Cle In Sheets("JULY15Release_Master Inventory").Range("A1:A" & lastRowE)
        If Cle.Value <> "" Then
            For Each Clf In Sheets("JULY15Release_Dev status").Range("A1:A" & lastRowF)
                If UCase(Cle.Value) = UCase(Clf.Value) Then DicInv.Add Cle.Row, ""
            Next Clf
        End If
    Next Cle
    'add into dictionary row number from Dev where cell is matched
    For Each Clf In Sheets("JULY15Release_Dev status").Range("A1:A" & lastRowF)
        If Clf.Value <> "" Then
            For Each Cle In Sheets("JULY15Release_Master Inventory").Range("A1:A" & lastRowE)
                If UCase(Clf.Value) = UCase(Cle.Value) Then DicDev.Add Clf.Row, ""
            Next Cle
        End If
    Next Clf
    'Get mismatch from Inventory
    With Sheets("JULY15Release_Master Inventory")
        For Each Cle In .Range("A1:A" & lastRowE)
            If Not DicInv.exists(Cle.Row) And Cle.Value <> "" Then
                .Rows(Cle.Row).Copy Sheets("Mismatch").Rows(lastRowM)
                lastRowM = lastRowM + 1
            End If
        Next Cle
    End With
    'Get mismatch from Dev
    With Sheets("JULY15Release_Dev status")
        For Each Clf In .Range("A1:A" & lastRowF)
            If Not DicDev.exists(Clf.Row) And Clf.Value <> "" Then
                .Rows(Clf.Row).Copy Sheets("Mismatch").Rows(lastRowM)
                lastRowM = lastRowM + 1
            End If
        Next Clf
    End With

    Application.ScreenUpdating = 1

    End Sub

<强>示例

JULY15Release_Master Inventory

JULY15Release_Dev status

输出结果

Mismatch