数据量比较大，想用VBA实现数据比对，请老师帮忙！

grf1973 · 发表于 2017-5-23 16:21

用数组字典也做了一个，结果和sql不同。。。。。

Sub tt()
Dim 总表 As Workbook, 报送表 As Workbook
Dim Flag As Boolean
Application.ScreenUpdating = False
Set 总表 = Workbooks.Open(ThisWorkbook.Path & "\社保总表.xls")
Set 报送表 = Workbooks.Open(ThisWorkbook.Path & "\社区报送表.xls")
Set d = CreateObject("scripting.dictionary")
arr = 总表.Sheets(1).[a2].CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 2)) = i
Next
总表.Close False
brr = 报送表.Sheets(1).[a2].CurrentRegion
报送表.Close False
Application.ScreenUpdating = True
ReDim crr(1 To 2 * UBound(brr), 1 To UBound(brr, 2))
Dim stRng As Range '填充区域的左上角单元格
Set stRng = [a3]
stRng.Resize(1000, 20).Clear
For i = 2 To UBound(brr)
ii = Val(d(brr(i, 2)))
If ii = 0 Then
n = n + 1
For k = 1 To UBound(brr, 2)
crr(n, k) = brr(i, k)
Next
stRng.Offset(n - 1).Resize(1, UBound(brr, 2)).Font.Color = vbRed
Else
Flag = False
For k = 1 To UBound(brr, 2)
If arr(ii, k) <> brr(i, k) Then Flag = True: stRng.Offset(n, k - 1).Font.Color = vbRed: stRng.Offset(n + 1, k - 1).Font.Color = vbRed
Next
If Flag Then
n = n + 1
For k = 1 To UBound(brr, 2)
crr(n, k) = brr(i, k)
crr(n + 1, k) = arr(ii, k)
Next
n = n + 1
End If
End If
Next
If n > 0 Then stRng.Resize(n + 1, UBound(brr, 2)) = crr
End Sub

复制代码

孙得力 · 发表于 2017-5-23 22:36

我也有类似的困惑，你知道如何操作后可以告知我啊。哈哈，我是1033798196

danhanqing · 发表于 2017-5-25 10:48

jjj2123456? 发表于 2017-5-23 14:23
怪了，我都下载过附件，居然显示一次都没有下载过

谢谢老师关注！

danhanqing · 发表于 2017-5-25 15:47

本帖最后由 danhanqing 于 2017-5-25 15:48 编辑

采用了zax010 老师的方案。完善后提交上来，供其他同学参考。

数据对比.rar (49.93 KB, 下载次数: 610)

danhanqing · 发表于 2017-5-25 15:53

grf1973 老师的字典数组法也非常赞！我学习一下也做一个完整的出来！

nsqrlj · 发表于 2017-6-25 16:19

学习了，谢谢

wjh98 · 发表于 2017-10-12 16:16

怎么我使用时，提示说宏被禁止了，是怎么回事？我测试其他的表时，没有发现这个问题呢？

pfz008 · 发表于 2018-5-15 16:39

学习了，今天遇到这样一个类似问题，先搜下就到这里，感谢各位老师帮助，下载后不知能不能修改我变成我要的结果，感谢各位

color_0918 · 发表于 2018-5-30 15:12

danhanqing 发表于 2017-5-25 15:47
采用了zax010 老师的方案。完善后提交上来，供其他同学参考。

很好的学习资料！

zglibk · 发表于 2018-6-26 23:01

点赞！收藏学习

		自动登录	找回密码
密码			免费注册

[已解决] 数据量比较大，想用VBA实现数据比对，请老师帮忙！