VBA比对两份文件，输出相同数据

Sub 查找相同点()

  工作簿1 = ActiveWorkbook.Name

  Sheets("表1").Select

  H1 = 2

  H2 = Cells(65536, 1).End(xlUp).Row

  L1 = 1

  L2 = Cells(1, 256).End(xlToLeft).Column

  For H = H1 To H2

      For L = L1 To L2

          If Sheets("表1").Cells(H, L) <>Sheets("表2").Cells(H, L) Then

              Sheets("表3").Cells(H, L) = LTrim(Str$(Sheets("表1").Cells(H, L))) + "," + LTrim(Str$(Sheets("表2").Cells(H, L)))

          End If

      Next

  Next

End Sub

假定文件夹为：E:\ABC，单元格为A1，代码如下：

wjm = Dir("E:\ABC\*.*")

Do While wjm <>""

If InStr(wjm, [A1]) >0 Then Exit Do

wjm = Dir

Loop

If wjm = "" Then [A1].Interior.ColorIndex = 3‘设置背景色为红色

下面是录制下来的VBA代码

ChangeFileOpenDirectory "D:\需要比较的文件夹名称\"

Application.CompareDocuments _

OriginalDocument:=Documents("需要比较的文档1.doc"), _

RevisedDocument:=Documents("需要比较的文档2.doc"), _

Destination:=wdCompareDestinationNew, _

Granularity:=wdGranularityWordLevel, _

CompareFormatting:=True, CompareCaseChanges:=True, _

CompareWhitespace:=True, CompareTables:=True, _

CompareHeaders:=True, CompareFootnotes:=True, _

CompareTextboxes:=True, CompareFields:=True, _

CompareComments:=True, CompareMoves:=True, _

RevisedAuthor:="guchzhAL", _

IgnoreAllComparisonWarnings:=False

ActiveWindow.ShowSourceDocuments = wdShowSourceDocumentsBoth

个人还是觉得这类的比较工作还是人工来完成比较好

审阅 → 比较

选择需要比较的文档

比较结果

---