VBA比较多行并查找不匹配的数据

希望有人能帮助我-我已经在论坛上读了几个小时了，找到了一些代码并对它们进行了调整，但无法找出如何让它们为我工作

我有一个包含两张工作表的文件。我需要查看工作表1中的B列（用户ID）、D列（日期）、G列（时间），找到所有与工作表2中A列（用户ID）、B列（日期）、C列（时间）不匹配的数据，并将工作表1中所有不匹配的数据（所有行/列）放到工作表3中。我采用了数组公式的方法，但要求更简洁，并且只在单独的表格中显示不匹配的信息，所以我认为VBA是最简单的方法

示例数据文件：

工作表1

Associate ID    Organization Name   Original Start Date Segment Start Date  Segment End Date    Time
83010   abc 4/8/2014    3/31/2014   4/1/2014    465
89551   abc 4/10/2014   4/1/2014    4/1/2014    30
90111   abc 4/9/2014    4/7/2014    4/7/2014    30
90136   abc 4/9/2014    4/7/2014    4/7/2014    445

工作表2

ED_EMP_NB   SCHED_DT    DURATION_MIN_AM
083010  4/8/2014    465
089551  4/10/2014   60
090111  4/9/2014    60
090136  4/9/2014    445

---

更新： 因此，我将您的代码tmoore82更新为参考图纸（3）和偏移量，以匹配行（我相信）。它会将14个不匹配行中的7行向后拉。。你能帮我找出错误吗

Sub Test2()

Dim rowCount1 As Long
Dim rowCount2 As Long

''EDITED TO CALL ON SHEET 3
rowCount1 = ThisWorkbook.Sheets(1).Range("B20").SpecialCells(xlCellTypeLastCell).Row
rowCount2 = ThisWorkbook.Sheets(3).Range("B2").SpecialCells(xlCellTypeLastCell).Row

Dim rng1 As Range
Dim rng2 As Range

''EDITED TO CALL ON SHEET 3
Set rng1 = ThisWorkbook.Sheets(1).Range("B20:B" & rowCount1)
Set rng2 = ThisWorkbook.Sheets(3).Range("B2:B" & rowCount2)

Dim currentRow As Long
currentRow = 2

''UPDATED OFFSET TO MATCH ROWS IN SHEET 3
For Each cell In rng1.Cells
For Each cell2 In rng2.Cells
If cell2.Value <> cell.Value And cell2.Offset(0, 5).Value <> cell.Offset(0, 5).Value And cell2.Offset(0, 2).Value <> cell.Offset(0, 2).Value Then
ThisWorkbook.Sheets(1).Rows(cell.Row).Copy Destination:=ThisWorkbook.Sheets(4).Range("A" & currentRow)
currentRow = currentRow + 1
GoTo NextIteration
End If
Next cell2
NextIteration:
Next cell

End Sub

子测试2（）
暗淡的行数与长的行数相同
暗行数与长行数相同
''编辑以调用第3页
rowCount1=ThisWorkbook.Sheets（1）.Range（“B20”）.SpecialCells（xlCellTypeLastCell）.Row
rowCount2=ThisWorkbook.Sheets（3）.范围（“B2”）.特殊单元格（xlCellTypeLastCell）.行
变暗rng1 As范围
变暗rng2 As范围
''编辑以调用第3页
Set rng1=ThisWorkbook.Sheets（1）.Range（“B20:B”和rowCount1）
设置rng2=ThisWorkbook.Sheets（3）.范围（“B2:B”和行计数2）
与当前行一样长
currentRow=2
''更新偏移量以匹配第3页中的行
对于rng1中的每个单元格。单元格
对于rng2中的每个单元格2。单元格
如果cell2.Value cell.Value和cell2.Offset（0,5）。Value cell.Offset（0,5）。Value和cell2.Offset（0,2）。Value cell.Offset（0,2）。Value则
ThisWorkbook.Sheets（1）.行（cell.Row）.复制目标：=ThisWorkbook.Sheets（4）.范围（“A”¤tRow）
currentRow=currentRow+1
后藤下滴度
如果结束
下一单元2
下一次滴定：
下一个细胞
端接头

好的，这不是最有效的代码，但它对示例数据有效。只要您的数据不是非常庞大，这就应该让您开始：

Sub Test()

    Dim rowCount1 As Long
    Dim rowCount2 As Long

    rowCount1 = ThisWorkbook.Sheets(1).Range("A2").SpecialCells(xlCellTypeLastCell).Row
    rowCount2 = ThisWorkbook.Sheets(2).Range("A2").SpecialCells(xlCellTypeLastCell).Row

    Dim rng1 As Range
    Dim rng2 As Range

    Set rng1 = ThisWorkbook.Sheets(1).Range("A2:A" & rowCount1)
    Set rng2 = ThisWorkbook.Sheets(2).Range("A2:A" & rowCount2)

    Dim sheet1() As Variant
    ReDim sheet1(rowCount1 - 1, 2)

    Dim n As Long
    n = 0

    For Each cell In rng1.Cells
        sheet1(n, 0) = cell.Value
        sheet1(n, 1) = cell.Offset(0, 2).Value
        sheet1(n, 2) = cell.Offset(0, 5).Value
        Debug.Print cell.Value
        n = n + 1
    Next cell

    Dim currentRow As Long
    currentRow = 1

    For n = 0 To UBound(sheet1)
        For Each cell In rng2.Cells
            If cell.Value = sheet1(n, 0) And cell.Offset(0, 1).Value = sheet1(n, 1) And cell.Offset(0, 2).Value = sheet1(n, 2) Then
                ThisWorkbook.Sheets(1).Rows(n + 2).Copy Destination:=ThisWorkbook.Sheets(3).Range("A" & currentRow)
                currentRow = currentRow + 1
                 GoTo NextIteration
            End If
         Next cell
NextIteration:
    Next n

End Sub

对新代码的响应

将循环更改为以下内容：

''UPDATED OFFSET TO MATCH ROWS IN SHEET 3
For Each cell In rng1.Cells
For Each cell2 In rng2.Cells
    If cell2.Value = cell.Value And cell2.Offset(0, 5).Value = cell.Offset(0, 5).Value And cell2.Offset(0, 2).Value = cell.Offset(0, 2).Value Then
'ThisWorkbook.Sheets(1).Rows(cell.Row).Cop Destination:=ThisWorkbook.Sheets(4).Range("A" & currentRow)
'currentRow = currentRow + 1
        GoTo NextIteration
    End If
Next cell2
ThisWorkbook.Sheets(1).Rows(cell.Row).Copy Destination:=ThisWorkbook.Sheets(4).Range("A" & currentRow)
currentRow = currentRow + 1
NextIteration:
Next cell

你明白为什么会这样吗

最终答案

在这里写博客：

---

这里：

你已经试过什么了？请给我们看一些代码。我把它添加到了我的主要问题中。谢谢你看。我在这里找到了代码，并一直试图对其进行调整，但未能使其正常工作。@user3632551请使用相应的“格式”按钮（它看起来像一个

{}

）对代码进行格式设置，以使其更易于阅读。此外，不要只在此处转储代码，还要突出显示哪些部分会导致问题/与预期输出不同。@谢谢！我是这个论坛的新手，所以还不能流利地使用它。至于代码，我真的不确定哪个部分不起作用，因为我对VBA相当陌生。我希望这里有人能给我指出正确的方向。