VBA比较两个工作表并复制行中的某些列(如果它们不同)

我想要做的是看两张不同的床单来比较人和他们的国民保险号码 .

表1是来自一个系统的一组数据,而表2是来自不同系统的另一组数据 . 我想要做的是首先比较两个工作表中的第1列,其中包含该人唯一的ID,一旦每个工作表中第1列的条目相同,那么这就是同一个人 . 然后

我当时想要做的是将存储17列的值与工作表1上的第1列右边的值进行比较,将第2列中的23列存储到右边(两者都是国家保险号) .

只有当它们不同时,我才想从Sheet 1(Number,FirstName和Surname)复制行的前3列和两张表中的国家保险号值(Sheet1(0,17)Sheet2(0,23)到表Sheet 3 .

这是我正在尝试的代码,它会在整个行中复制整行,如果逻辑工作,我可以更改为仅复制我想要的单元格,但无济于事似乎是复制几乎整个表格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

回答(2)

2 years ago

遇到类似的问题,我发现使用 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是一篇提供优秀解释的文章的链接 .

2 years ago

你好我现在已经对它进行了排序,我意识到当偏移量从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