Excel如何實現兩個工作表數據的對比

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

 

Sub 數據對比()
    Dim i As Integer
    Dim j As Integer
    For i = 2 To 3225      '員工基礎報表數據范圍
        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 = 2 To 3225      '員工基礎報表數據范圍
        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 = 2 To 3225      '員工基礎報表數據范圍
        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 = 2 To 3225      '員工基礎報表數據范圍
        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 = 2 To 1362      '源表
        For j = 2 To 1182    'overlay表
         'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then
            If Sheets("old").Cells(i, 1) = Sheets("new").Cells(j, 1) Then
               Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).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 = 2 To 1364      '源表
        For j = 2 To 1183    'overlay表
         'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then
            If StrComp(Sheets("old").Cells(i, 1).Value, Sheets("new").Cells(j, 1).Value, 1) = 0 Then
               Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).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 = 2 To 1364      '源表
        For j = 2 To 1183    'overlay表
         'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then
            If StrComp(Trim(Sheets("old").Cells(i, 1).Value), Trim(Sheets("new").Cells(j, 1).Value), 1) = 0 Then
               Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).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 = 2 To sLength
        For j = 2 To dLength
        'If Sheets("old").Cells(i, 4) = Sheets("new").Cells(j, 4) Then
            If StrComp(Trim(Sheets("old").Cells(i, 1).Value), Trim(Sheets("new").Cells(j, 1).Value), 1) = 0 Then
               Sheets("old").Cells(i, 2) = Sheets("new").Cells(j, 2).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(1) '第一個工作表
    Set dSheet = Sheets(2) '第二個工作表
    
    '獲取工作表總列數
    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 = 2 To sLength '第一行是標題行
        For j = 2 To dLength
            If StrComp(Trim(sSheet.Cells(i, 1).Value), Trim(dSheet.Cells(j, 1).Value), 1) = 0 Then
               sSheet.Cells(i, 2) = dSheet.Cells(j, 2).Value   '將目標工作表的第二列賦值到源工作表的第二列
            End If
        Next j
    Next i
    Application.ScreenUpdating = True '重新開啟屏幕更新
    
    '數據匹配完成后彈出提醒
    MsgBox "匹配完成！"
End Sub