Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 203|回复: 1

[已解决] [已解决]外部数据实时更新累计数据如何实现?求助啊!

[复制链接]
发表于 2017-6-19 23:48 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
外部数据模块,未设置自动刷新.
每次手动刷新后会自动覆盖,只好想到在工作表2中采取引用匹配的方式实现数据累积.
数据比较大,长时间开机搜集.
工作表2的指定区域已经标出,希望能过滤掉重复数据,以B列为参考.
还请能人,高手,大神多多帮忙.
拜托拜托!
谢谢咯.

工作表1

工作表1
2.png

附件.zip

25.21 KB, 下载次数: 1

chart888发布于 2017-6-20 22:42 |显示全部回帖
本帖最后由 chart888 于 2017-6-20 22:49 编辑
  1. Private Sub CommandButton1_Click()
  2. Dim arr, brr
  3. Dim i&, j&, r&
  4. Application.ScreenUpdating = False
  5. On Error Resume Next
  6. Set D = CreateObject("Scripting.Dictionary")
  7. With Sheets("工作表2")
  8.     arr = .Range("B2:B" & .Cells(Rows.Count, 2).End(3).Row)
  9.     brr = Sheets("工作表1").Range("B2:G" & Sheets("工作表1").Cells(Rows.Count, 2).End(3).Row)
  10.     For i = 1 To UBound(arr)
  11.         D(arr(i, 1)) = i + 1
  12.     Next
  13.     r = UBound(arr) + 1
  14.     For j = 1 To UBound(brr)
  15.         If D.exists(brr(j, 1)) = False Then
  16.             r = r + 1
  17.             .Cells(r, 2) = brr(j, 1): .Cells(r, 3) = brr(j, 2)
  18.             .Cells(r, 4) = brr(j, 3): .Cells(r, 5) = brr(j, 4)
  19.             .Cells(r, 6) = brr(j, 5): .Cells(r, 7) = brr(j, 6)
  20.         End If
  21.     Next
  22. End With
  23. Application.ScreenUpdating = True
  24. End Sub
复制代码
发表于 2017-6-20 22:42 | 显示全部楼层    本楼为最佳答案   
本帖最后由 chart888 于 2017-6-20 22:49 编辑
  1. Private Sub CommandButton1_Click()
  2. Dim arr, brr
  3. Dim i&, j&, r&
  4. Application.ScreenUpdating = False
  5. On Error Resume Next
  6. Set D = CreateObject("Scripting.Dictionary")
  7. With Sheets("工作表2")
  8.     arr = .Range("B2:B" & .Cells(Rows.Count, 2).End(3).Row)
  9.     brr = Sheets("工作表1").Range("B2:G" & Sheets("工作表1").Cells(Rows.Count, 2).End(3).Row)
  10.     For i = 1 To UBound(arr)
  11.         D(arr(i, 1)) = i + 1
  12.     Next
  13.     r = UBound(arr) + 1
  14.     For j = 1 To UBound(brr)
  15.         If D.exists(brr(j, 1)) = False Then
  16.             r = r + 1
  17.             .Cells(r, 2) = brr(j, 1): .Cells(r, 3) = brr(j, 2)
  18.             .Cells(r, 4) = brr(j, 3): .Cells(r, 5) = brr(j, 4)
  19.             .Cells(r, 6) = brr(j, 5): .Cells(r, 7) = brr(j, 6)
  20.         End If
  21.     Next
  22. End With
  23. Application.ScreenUpdating = True
  24. End Sub
复制代码

附件.zip

32.32 KB, 下载次数: 3

回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2017-8-23 10:17 , Processed in 0.078000 second(s), 22 queries , Gzip On, Memcache On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表