VBA Excel根据列复制行 [英] VBA Excel copy rows based on column

问题描述

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

I'm trying to create a macro which copies rows of data after comparing a column value. I previously asked this question but made some progress, and thought it would be less confusing if i posted another question. The column to be compared is "eRequest ID" and it consists of integers and text.

我有两个工作表，两个都是eRequest ID作为第一列。这里的目的是在两个工作表中复制任何具有eRequest ID NOT FOUND 的数据行。这意味着如果这个记录的eRequest ID只在一个工作表中找到，而不是两个，那么整行的数据必须被复制到第三个新的工作表中。

I have two worksheets, both with "eRequest ID" as the first column. The goal here is to copy ANY rows of data that has an "eRequest ID" NOT FOUND in both worksheets. Meaning if this record's "eRequest ID" is only found on one worksheet and not both, the whole row of data has to be copied into a third new worksheet.

我有在浏览网页后，在编码专家的帮助下制定了一些代码。这个代码的问题是，我以某种方式得到每一行的不匹配。我尝试在这里和那里更改 foundTrue 值，但似乎不起作用。我只需要在任一工作表上复制 1eRequest ID的数据行。非常有帮助，感谢您的努力！

I have worked out some codes after browsing through the net, and with the help of the coding experts here. The problem with this codes is that somehow I get a "mismatch" for every row. I tried changing the foundTrue value here and there but it doesn't seem to work. I need it to only copy rows of data with only 1 "eRequest ID" on either worksheet. Greatful for any help and appreciate your effort!

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

推荐答案

尝试这个，应该工作，检测过即可。

Try this, it should work, 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

这篇关于VBA Excel根据列复制行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！