VBA比较两张纸并复制行中的某些列（如果它们不同）

Question

我要做的是查看两张不同的表格来比较人们和他们的国民保险号码。

表 1 是来自一个系统的一组数据，表 2 是来自不同系统的另一组数据。我想要做的是首先比较两张表中的第 1 列，其中包含该人唯一的 id，一旦每张表中第 1 列中的条目相同，那么这就是同一个人。那么

然后我想要做的是比较存储在表 1 上第 1 列右侧的 17 列和表 2 上右侧 23 列的值（两者都是国家保险号码）。

只有当它们不同时，我才想复制表 1 中行的前 3 列（编号、名字和姓氏）以及两张表中的国民保险编号值（Sheet1(0,17)Sheet2(0, 23) 到 Sheet3。

这是我正在尝试的代码，它最初复制整行，如果逻辑有效，我可以更改为仅复制我想要的单元格，但无济于事，它似乎复制了几乎整个工作表 1.....

Sub compareData()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Long, j As Long
    Dim newSheetPos As Integer

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Set ws3 = ActiveWorkbook.Sheets("Sheet3")

    newSheetPos = ws3.Cells(ws3.Rows.Count, 2).End(xlUp).Row

    For i = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
        For j = 1 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
            If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value Then
                If ws1.Cells(i, 17).Value <> ws2.Cells(j, 23).Value Then
                    ws1.Cells(j, 1).EntireRow.Copy ws3.Cells(newSheetPos, 1)
                    newSheetPos = newSheetPos + 1
                Else
                End If
            Else
            End If
        Next j
    Next i
End Sub

Answer 1

遇到类似问题后，我发现使用Trim(), UCase() 和.Value2 属性可以消除许多由格式和/或文本大小写引起的不匹配。如果您使用 Trim() 和 .Value2，您的代码应该如下所示。

If Trim(ws1.Cells(i, 1).Value2) = Trim(ws2.Cells(j, 1).Value2) Then
    If Trim(ws1.Cells(i, 17).Value2) <> Trim(ws2.Cells(j, 23).Value2) Then
        ws1.Cells(j, 1).EntireRow.Copy ws3.Cells(newSheetPos, 1)
        newSheetPos = newSheetPos + 1
    Else
    End If
End If

存储在单元格中的值可以被.Text、.Value 或.Value2 引用。 Value2 提供没有任何格式的基础值。 TEXT vs VALUE vs VALUE2 是一篇文章的链接，提供了很好的解释。

Answer 2

您好，我现在已经对此进行了排序，我意识到由于偏移量从 1 而不是 0 开始，因此我必须将标准偏移量增加 1，请参见下文

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Long, j As Long
    Dim newSheetPos As Integer

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Set ws3 = ActiveWorkbook.Sheets("NINO Differences")

    newSheetPos = ws3.Cells(ws3.Rows.Count, 2).End(xlUp).Row

    For i = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
        For j = 1 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row

            If Trim(ws1.Cells(i, 1).Value2) = Trim(ws2.Cells(j, 1).Value2) Then

                If Trim(ws1.Cells(i, 17).Value2) <> Trim(ws2.Cells(j, 24).Value2) Then
                    ws1.Cells(j, 1).EntireRow.Copy ws3.Cells(newSheetPos, 1)
                    newSheetPos = newSheetPos + 1
                Else
                End If
            Else
            End If

        Next j
    Next i