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

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

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

果你的数据规则的，用VBA 很快的：（请用副本测试！！，没问题再把结果保存为正本！！）

测试完成后：在sub 后 代码前加 Application.ScreenUpdating = False ，并在Msgbox 前加Application.ScreenUpdating = True  更快！！

---------------------------------------

Sub 删除A表中相同数据行()

ON ERROR GOTO ExitEnd

Application.ScreenUpdating = False

。。。(原代码部分）

Application.ScreenUpdating = True

MsgBox "完成对比啦~_~", vbExclamation

ExitEnd:

On Error Goto 0

Application.ScreenUpdating = True

End Sub

------------------

以下为不加Application.ScreenUpdating, 会慢一些：

Sub 删除A表中相同数据行()

  '前提是数据要规则

  '假设A表C\D\J 列与B表B\C\F列数据对比，且数据次序一样，

  '即C对B  D对C J对F

  '思路：能引用EXCEL本身的方法不用VBA方法，这样快！！

  ThisWorkbook.Activate

  Dim BiaoA As Object, BiaoB As Object

  Dim RowStart&, RowEndA&, RowEndB&, i&'数据起始行与终止行

  Dim GongShi$

  Dim CLA As Range, CLB As Range

  Set BiaoA = Sheets("表A")   '“表A”换成实际的A工作表名称

  Set BiaoB = Sheets("表B")   '“表B”换成实际的B工作表名称

  RowStart = 1    '如果有表头改为2

  RowEndA = BiaoA.Cells(RowS.Count, "C").End(xlUp).Row

  RowEndB = BiaoB.Cells(RowS.Count, "B").End(xlUp).Row

  BiaoA.Activate

  Columns("A:A").Insert

  GongShi = "=D" &RowStart &"&E" &RowStart &"&K" &RowStart

  '因临时插入一列：C-D-J 相应变为D-E-K

  Cells(RowStart, "A").Formula = GongShi

  Cells(RowStart, "A").Copy

  Range(Cells(RowStart, "A"), Cells(RowEndA, "A")).Select

  ActiveSheet.Paste

  Selection.Copy

  Selection.PasteSpecial Paste:=xlPasteValues

  BiaoB.Activate

  Columns("A:A").Insert

  GongShi = "=C" &RowStart &"&D" &RowStart &"&G" &RowStart

  '因临时插入一列：B-C-F 相应变为C-D-G

  Cells(RowStart, "A").Formula = GongShi

  Cells(RowStart, "A").Copy

  Range(Cells(RowStart, "A"), Cells(RowEndB, "A")).Select

  ActiveSheet.Paste

  Selection.Copy

  Selection.PasteSpecial Paste:=xlPasteValues

  For Each CLA In Range(BiaoA.Cells(RowStart, "A"), BiaoA.Cells(RowEndA, "A"))

      For Each CLB In Range(BiaoB.Cells(RowStart, "A"), BiaoB.Cells(RowEndB, "A"))

          If CLA.Value = CLB.Value Then BiaoA.RowS(CLA.Row).ClearContents

      Next

  Next

  BiaoB.Activate

  Columns("A:A").Delete

  BiaoA.Activate

  For i = RowEndA To RowStart Step -1

      If Len(Cells(i, "A").Value) = 0 Then RowS(i).Delete

  Next

  Columns("A:A").Delete

  Set BiaoA = Nothing

  Set BiaoB = Nothing

  MsgBox "完成对比啦~_~", vbExclamation

End Sub

---