[已解决]坛友们帮帮忙啊咋能实现对比两个文件呢

Syndra

我想对比两个Excel文件并将相同值所在的行写入一个新表中，
坛友们，帮帮忙如何实现？

最佳答案

月排行榜 / 总排行榜

0126

2017-9-28 16:52

Sub cz()
Dim s1 As Workbook, s2 As Workbook, m, o, b(1 To 100000, 1 To 7), d, k As Long, x As Long
Set d = CreateObject("scripting.dictionary")   '创建字典
Set s1 = GetObject(ThisWorkbook.Path & "\M.xlsx") '打开代码所在路径的m表，如果代码所在表格的路径下没有这个文件就会出错
     m = s1.Sheets(1).Range("a1").CurrentRegion  '把m表数值放入变量m
     s1.Close False  '关闭 不保存
Set s2 = GetObject(ThisWorkbook.Path & "\O.xlsx")
     o = s2.Sheets(1).Range("a1").CurrentRegion
     s2.Close False
If UBound(m, 2) < 15 Or UBound(o, 2) < 8 Then MsgBox "数据不完全": Exit Sub
For x = 1 To UBound(m)    '把要对比的其中一个 m 表对比值放入字典
  d(m(x, 15) & m(x, 13)) = x
Next
For x = 1 To UBound(o)
  If d.exists(o(x, 1)) Then   '查询字典里面是否有o表对比值
   k = k + 1
   b(k, 1) = m(d(o(x, 1)), 2)
   b(k, 2) = m(d(o(x, 1)), 3)
   b(k, 3) = o(x, 5)
   b(k, 4) = o(x, 6)
   b(k, 7) = o(x, 8)
  End If
Next
Set s3 = GetObject(ThisWorkbook.Path & "\B.xlsx")  '打开b表第一个表a列最后一个有数据的单元格行数下面开始放入匹配的数值 并关闭 保存
     s3.Sheets(1).Range("a" & s3.Sheets(1).Cells(Rows.Count, 1).End(3).Row + 1).Resize(k, 7) = b
     s3.Close True
End Sub

跳转到最佳答案楼层

0126

Sub cz()
Dim s1 As Workbook, s2 As Workbook, m, o, b(1 To 100000, 1 To 7), d, k As Long, x As Long
Set d = CreateObject("scripting.dictionary")   '创建字典
Set s1 = GetObject(ThisWorkbook.Path & "\M.xlsx") '打开代码所在路径的m表，如果代码所在表格的路径下没有这个文件就会出错
     m = s1.Sheets(1).Range("a1").CurrentRegion  '把m表数值放入变量m
     s1.Close False  '关闭 不保存
Set s2 = GetObject(ThisWorkbook.Path & "\O.xlsx")
     o = s2.Sheets(1).Range("a1").CurrentRegion
     s2.Close False
If UBound(m, 2) < 15 Or UBound(o, 2) < 8 Then MsgBox "数据不完全": Exit Sub
For x = 1 To UBound(m)    '把要对比的其中一个 m 表对比值放入字典
  d(m(x, 15) & m(x, 13)) = x
Next
For x = 1 To UBound(o)
  If d.exists(o(x, 1)) Then   '查询字典里面是否有o表对比值
   k = k + 1
   b(k, 1) = m(d(o(x, 1)), 2)
   b(k, 2) = m(d(o(x, 1)), 3)
   b(k, 3) = o(x, 5)
   b(k, 4) = o(x, 6)
   b(k, 7) = o(x, 8)
  End If
Next
Set s3 = GetObject(ThisWorkbook.Path & "\B.xlsx")  '打开b表第一个表a列最后一个有数据的单元格行数下面开始放入匹配的数值 并关闭 保存
     s3.Sheets(1).Range("a" & s3.Sheets(1).Cells(Rows.Count, 1).End(3).Row + 1).Resize(k, 7) = b
     s3.Close True
End Sub