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

zhengmingdeng

外部数据模块,未设置自动刷新.

每次手动刷新后会自动覆盖,只好想到在工作表2中采取引用匹配的方式实现数据累积.

数据比较大,长时间开机搜集.

工作表2的指定区域已经标出,希望能过滤掉重复数据,以B列为参考.

还请能人,高手,大神多多帮忙.

拜托拜托!

谢谢咯.

最佳答案

月排行榜 / 总排行榜

chart888

2017-6-20 22:42

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

复制代码

跳转到最佳答案楼层

chart888

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

复制代码