用vba做excel两个表的比对

Posted 2023-03-18

本人学艺不精，工作需要，急求用vba做excel两个表的比对
备注1：比对离线系统与在线系统的E列。在线系统没有的数据整行自动复制到sheet3中
备注2：比对在线系统与离线系统的E列。离线系统没有的数据整行自动复制到sheet3中

交换比对，尽量做两个文件
附件，http://pan.baidu.com/s/1i5qAbDb

Sub 备注1() '比对离线系统与在线系统的E列。在线系统没有的数据整行自动复制到sheet3中
Application.ScreenUpdating = False
Dim Dic, i%, n%
Sheets("离线系统").[1:1].Copy Sheets("Sheet3").[A1]
Sheets("Sheet3").UsedRange.Offset(1).Delete
n = 1
Sheets("在线系统").Activate
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To [A1].CurrentRegion.Rows.Count
Dic(Cells(i, "E").Value) = ""
Next
Sheets("离线系统").Activate
For i = 2 To [A1].CurrentRegion.Rows.Count
If Not Dic.Exists(Cells(i, "E").Value) Then
n = n + 1
Rows(i).Copy Sheets("Sheet3").Rows(n)
End If
Next
Sheets("Sheet3").Activate
Application.ScreenUpdating = True
End Sub

　　备注1运行结果:

    

Sub 备注2() '比对在线系统与离线系统的E列。离线系统没有的数据整行自动复制到sheet3中
Application.ScreenUpdating = False
Dim Dic, i%, n%
Sheets("离线系统").[1:1].Copy Sheets("Sheet3").[A1]
Sheets("Sheet3").UsedRange.Offset(1).Delete
n = 1
Sheets("离线系统").Activate
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To [A1].CurrentRegion.Rows.Count
Dic(Cells(i, "E").Value) = ""
Next
Sheets("在线系统").Activate
For i = 2 To [A1].CurrentRegion.Rows.Count
If Not Dic.Exists(Cells(i, "E").Value) Then
n = n + 1
Rows(i).Copy Sheets("Sheet3").Rows(n)
End If
Next
Sheets("Sheet3").Activate
Application.ScreenUpdating = True
End Sub

　　备注2运行结果:

    

 

参考技术A 感觉用Excel公式就能做吧，Vlookup

比较结果分两个文件，那么再加上一个Sheet4不就好了

离线中找在线里面没有的数据：
A.在辅助列，比如H列，H2中输入公式
=VLOOKUP(E2,在线系统!$E:$E$,1,FALSE) ，下拉填充
B。对此列进行筛选，找出结果是#NA的行
C.将筛选出的数据复制到新的Sheet中就行了。

在在线Sheet中找离线中没有的数据，也类似
只是公式变成=VLOOKUP(E2,离线系统!$E:$E,1,FALSE)，其他一样

两个数据表如何VBA实现比对？

两个表格的数据格式基本相同，分别保存在“sheet1”和“sheet2”中，但由于是由两个人输入的，肯定会存在差异，现在需要进行比对，相同的在“核对”列标记ok，不相同的则不标记；“品名”、“数量”、“电话”必须一致，“时间”在两个日期差不大于2的情况下视为一致（如：9日和7日视为一致，因为9-7=2），否则视为不是同一笔业务，只有上述4个条件都一致时可标记为ok，否则不予标记。

很多人提过二个表格数据如何校对？现给出一个示例。为了方便看清除需要校对和被校对数据，这里把二个数据放在一张工作表中，第二个数据中黄色背景的数据与第一个数据不一样。

Sub text()
    Dim a, b, d
    a = [a2:f15]
    b = [a21:f34]
    Set d = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(a)
        If Not d.exists(a(i, 2) & a(i, 3) & a(i, 4) & a(i, 5)) Then
           d(a(i, 2) & a(i, 3) & a(i, 4) & a(i, 5)) = ""
        End If
    Next
    For i = 1 To UBound(b)
        If d.exists(b(i, 2) & b(i, 3) & b(i, 4) & b(i, 5)) Then
           If Abs(a(i, 1) - b(i, 1)) <= 2 Then Cells(i + 1, 7) = "ok"
        End If
    Next
End Sub

参考技术A 说好工钱我会。