VBA Excel基于列复制行

我试图创建一个宏，在比较列值后复制数据行。我以前问过这个问题，但取得了一些进展，并认为如果我再发布一个问题，就不会那么混乱了。要比较的列是eRequest ID，它由整数和文本组成

我有两个工作表，都以eRequest ID作为第一列。这里的目标是复制两个工作表中都找不到eRequest ID的任何数据行。这意味着，如果此记录的eRequest ID仅在一个工作表中找到，而不是在两个工作表中都找到，则必须将整行数据复制到第三个新工作表中

在网上浏览之后，在这里的编码专家的帮助下，我已经编出了一些代码。这个代码的问题是，不知何故，我得到的每一行不匹配。我尝试在这里或那里更改foundTrue值，但似乎不起作用。我需要它只复制两个工作表上只有1个eRequest ID的数据行。非常感谢您的帮助，感谢您的努力

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

试试这个，它应该可以工作，经过测试

另一种变体

    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

样品

2015年7月发布\u主库存

7月15日发布开发状态

输出结果

不匹配

---

我刚刚发现SheetsJULY15Release_Dev status中的所有数据都可以在SheetsJULY15Release_主目录中找到，因此可能可以忽略比较部分。只有在SheetsJULY15Release_主目录中找不到eRequest ID的行需要复制到SheetsMatch。此外，通过编辑上述代码，我成功地复制了仅在SheetsJULY15Release_Dev status'中找到的行，但也复制了SheetsJULY15Release_主目录中的一些行。。希望这有帮助，提前谢谢！嘿！感谢您的帮助，代码运行良好，从两个工作表复制数据。但是，它仍在复制两个工作表上都有eRequest ID的数据行。我需要在任一工作表*上只有eRequest ID的行。也许它与**范围值有关？我不确定，我在这方面完全是个新手。你能帮我吗？多谢各位@俊杰，你能提供数据样本吗？当然可以，但我怎么做？我不知道这里的情况如何。。有没有让我与你共享文件的功能？？？@JunJie帖子已经更新，请重新检查，我想问题是a=a不匹配的情况，因为大写字母不等于小写字母，我只是尝试了编辑过的代码。。不过这没什么区别，有什么办法我可以和你共享这些文件吗？嘿，我不能再添加一列，因为我的表格有一些格式。。是否有其他方法可以在不添加新列的情况下执行此操作@瓦西里的答案似乎很接近，但它仍然在复制错误的行。也许你能弄明白？非常感谢。嘿，谢谢你的帮助。我得到了一个下标超出范围的错误，但是，在这一行，p=Application.MatchSheetsJULY15Release\u Dev status.RangeA&j.Value，SheetsSheet1.RangeA1&:&a&lrow1，0您能修复它并回复我吗？非常感谢：将Sheet1替换为您的工作表名称。替换Sheet1='JULY15Release_Dev status'和sheet2='JULY15Release_Master Inventory'，但是您需要我只是相应地更改了工作表名称，但是当我运行代码nothings Occessings Git时，您可能需要跟踪每一步的错误所在

    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