Excel如何实现两个工作表数据的对比

https://jingyan.baidu.com/article/63f236281f17650208ab3d97.html

Sub 数据对比()

    Dim i As Integer

    Dim j As Integer

    For i =  To       '员工基础报表数据范围

        For j = 2 To 2028    '员工待遇统计表数据范围

         If Sheets("old").Cells(i, 6) = Sheets("new").Cells(j, 6) Then

               Sheets("old").Cells(i, 8) = "已存在"   '存在时进行标记

         End If

        Next j

    Next i

End Sub

前面插入一列"Index"序号

Sub 数据对比()

    Dim i As Integer

    Dim j As Integer

    For i =  To       '员工基础报表数据范围

        For j = 2 To 2028    '员工待遇统计表数据范围

         If Sheets("old").Cells(i, 7) = Sheets("new").Cells(j, 7) Then

               Sheets("old").Cells(i, 11) = "已存在"   '存在时进行标记

               Sheets("new").Cells(j, 11) = "源表已存在"   '存在时进行标记

               Sheets("old").Cells(i, 12) = i

               Sheets("new").Cells(j, 12) = i

         End If

        Next j

    Next i

End Sub

双重过滤，才能精准

Sub 数据对比()

    Dim i As Integer

    Dim j As Integer

    For i =  To       '员工基础报表数据范围

        For j = 2 To 2028    '员工待遇统计表数据范围

         If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

            If Sheets("old").Cells(i, 7) = Sheets("new").Cells(j, 7) Then

               Sheets("old").Cells(i, 11) = "已存在"   '存在时进行标记

               Sheets("new").Cells(j, 11) = "源表已存在"   '存在时进行标记

               Sheets("old").Cells(i, 12) = i

               Sheets("new").Cells(j, 12) = i

            End If

        End If

        Next j

    Next i

End Sub

成功匹配：

Sub 数据对比()

    Dim i As Integer

    Dim j As Integer

    For i =  To       '员工基础报表数据范围

        For j = 2 To 2028    '员工待遇统计表数据范围

         If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

            If Sheets("old").Cells(i, 7) = Sheets("new").Cells(j, 7) Then

               Sheets("old").Cells(i, 11) = "已存在"   '存在时进行标记

               Sheets("new").Cells(j, 11) = "源表已存在"   '存在时进行标记

               Sheets("old").Cells(i, 12) = i

               Sheets("new").Cells(j, 12) = i

            End If

        End If

        Next j

    Next i

End Sub

---

数值填充(大小写、双引号不能模糊匹配，需要改善)

Sub 数据对比()

    Dim i As Integer

    Dim j As Integer

    For i =  To       '源表

        For j =  To     'overlay表

         'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

            If Sheets("old").Cells(i, ) = Sheets("new").Cells(j, ) Then

               Sheets("old").Cells(i, ) = Sheets("new").Cells(j, ).Value   '存在时进行标记

            End If

        'End If

        Next j

    Next i

End Sub

改善后代码：

Option Compare Text

Sub 数据对比()

    Dim i As Integer

    Dim j As Integer

    For i =  To       '源表

        For j =  To     'overlay表

         'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

            If StrComp(Sheets("old").Cells(i, ).Value, Sheets("new").Cells(j, ).Value, ) =  Then

               Sheets("old").Cells(i, ) = Sheets("new").Cells(j, ).Value   '存在时进行标记

            End If

        'End If

        Next j

    Next i

End Sub

或添加"Trim"函数过滤外侧空格

Option Compare Text

Sub 数据对比()

    Dim i As Integer

    Dim j As Integer

    For i =  To       '源表

        For j =  To     'overlay表

         'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

            If StrComp(Trim(Sheets("old").Cells(i, ).Value), Trim(Sheets("new").Cells(j, ).Value), ) =  Then

               Sheets("old").Cells(i, ) = Sheets("new").Cells(j, ).Value   '存在时进行标记

            End If

        'End If

        Next j

    Next i

End Sub

再次改善代码，自动获取最后一行的长度

Option Compare Text

Sub 数据对比()

    Dim sLength As Integer '记录源表长度

    Dim dLength As Integer '记录目标表长度

    Dim i As Integer

    Dim j As Integer

    sLength = Sheets("old").Cells(Rows.Count, "A").End(xlUp).Row

    dLength = Sheets("new").Cells(Rows.Count, "A").End(xlUp).Row

    Debug.Print "source sheet length:" & sLength

    Debug.Print "dir sheet length:" & dLength

    For i =  To sLength

        For j =  To dLength

        'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then

            If StrComp(Trim(Sheets("old").Cells(i, ).Value), Trim(Sheets("new").Cells(j, ).Value), ) =  Then

               Sheets("old").Cells(i, ) = Sheets("new").Cells(j, ).Value   '存在时进行标记

            End If

        'End If

        Next j

    Next i

End Sub

再次改善：声明工作表引用类型

Option Explicit

Option Compare Text

Sub 数据匹配导入()

    '声明语句

    Dim i As Integer

    Dim j As Integer

    Dim sLength As Integer '源工作表长度

    Dim dLength As Integer '目标工作表长度

    Dim sSheet As Sheet1 '源工作表

    Dim dSheet As Sheet2 '目标工作表

    '赋值语句

    'Set sSheet = Sheets("old") 'old是源工作表的名称

    'Set dSheet = Sheets("new") 'new是目标工作表的名称

    Set sSheet = Sheets() '第一个工作表

    Set dSheet = Sheets() '第二个工作表

    '获取工作表总列数

    sLength = sSheet.Cells(Rows.Count, "A").End(xlUp).Row

    dLength = dSheet.Cells(Rows.Count, "A").End(xlUp).Row

    '打印总列数

    Debug.Print "source sheet length:" & sLength

    Debug.Print "dir sheet length:" & dLength

    Application.ScreenUpdating = False '关闭屏幕更新

    For i =  To sLength '第一行是标题行

        For j =  To dLength

            If StrComp(Trim(sSheet.Cells(i, ).Value), Trim(dSheet.Cells(j, ).Value), ) =  Then

               sSheet.Cells(i, ) = dSheet.Cells(j, ).Value   '将目标工作表的第二列赋值到源工作表的第二列

            End If

        Next j

    Next i

    Application.ScreenUpdating = True '重新开启屏幕更新

    '数据匹配完成后弹出提醒

    MsgBox "匹配完成！"

End Sub