Question

希望有人可以帮助我 - 我已经在论坛上阅读了几个小时了，并且已经找到了一些代码并且一直在调整它们但是无法弄清楚如何让它们为我工作。

我有一个包含2个工作表的文件。我需要查看工作表1中的B列（用户ID），D（日期），G（时间），找到所有与工作表2列A（用户ID），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

更新：所以我把你的代码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/

VBA比较多行并查找错误匹配数据

1 个答案: