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