VBA Excel根据列复制行

我试图创build一个macros，比较列值后复制数据的行。 我以前问过这个问题，但是取得了一些进展，并且认为如果我发表另外一个问题就不那么困惑了。 要比较的列是“eRequest ID”，它由整数和文本组成。

我有两张工作表，都是“eRequest ID”作为第一列。 这里的目标是复制两个工作表中具有“eRequest ID”未find的 任何数据行。 这意味着如果这个logging的“eRequest ID”只能在一个工作表中find，而不是两个，那么整行数据必须复制到第三个新的工作表中。

在浏览网页之后，我在这里的编码专家的帮助下编写了一些代码。 这个代码的问题是，不知何故，我得到了“不匹配”的每一行。 我尝试改变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 

Answer 1

另一个变种

  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

Answer 2

尝试这个，它应该工作， testing 。

 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