VBA比較多行並找到錯誤匹配的數據

Question

希望有人可以幫助我 - 我一直在通過論壇閱讀幾個小時，並已發現一些代碼，並一直在調整它們，但無法弄清楚如何使它們適用於我。

我有一個包含2個工作表的文件。我需要從工作表1中查看B列（userid），D（日期），G（時間），並查找所有不匹配工作表2列A（userid），B（日期），C（時間）並將所有非將工作表1中的數據（所有行/列）與工作表3匹配。我走了一個數組公式的路線，但要求想要更乾淨的東西，只顯示在一張單獨的表中不匹配的信息，所以我認爲VBA將是最簡單的。

示例數據文件：https://docs.google.com/file/d/0B-05LU9z79UTQUs3QnRSSUZETmM/edit

Worksheet1

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 

Worksheet2

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 

---

UPDATE： 所以我把你的代碼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 

Answer 1

好的，這不是最有效的代碼，但它對樣本數據起作用。只要你的數據不是非常巨大的，這應該讓你開始：

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 

你看看爲什麼這有效？

最終答案

在博客在這裏：http://htddi.wordpress.com/2014/05/16/anatomy-of-a-stackoverflow-discussion/

這裏：http://htddi.wordpress.com/2014/05/16/anatomy-of-a-stackoverflow-discussion-part-ii/