[已解决]请教高手：数据导入不知能否用宏代码解决

BL123123

各位高手：
我有一数据导入表格，数量很大，我使用某列数据不重复数组公式及VLOOKUP函数等公式，虽然能导入，
但是运行速度很慢，且在次重新打开工作簿时，总是出现：正在计算（2个处理器）*%，运行非常
缓慢，请教高手能否用宏代码解决，恳请高手帮助解决，谢谢
详见截图及附件

最佳答案

月排行榜 / 总排行榜

today0427

2016-9-19 22:53

1. Sub dy()
   
2.     Dim arr, brr, i&, n&, d As Object, k, it
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("汇总").[a1].CurrentRegion
   
5.     For i = 5 To UBound(arr)
   
6.         If arr(i, 3) <> "" Then d(arr(i, 3)) = d(arr(i, 3)) + arr(i, 13)
   
7.     Next
   
8.     k = d.keys: it = d.items
   
9.    
   
10.     With Sheets("导入")
    
11.     brr = .Range("e6:f" & .[e65536].End(3).Row)
    
12.         For i = 1 To UBound(brr)
    
13.             For n = 0 To d.Count - 1
    
14.                 If brr(i, 1) = k(n) Then
    
15.                     brr(i, 2) = it(n): Exit For
    
16.                 End If
    
17.             Next
    
18.         Next
    
19.     .[f6].Resize(i - 1, 1).Clear
    
20.     .[f6].Resize(i - 1, 1) = Application.Index(brr, , 2)
    
21.     d.RemoveAll
    
22.     End With
    
23. End Sub

复制代码

跳转到最佳答案楼层

today0427

1. Sub dy()
   
2.     Dim arr, brr, i&, n&, d As Object, k, it
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("汇总").[a1].CurrentRegion
   
5.     For i = 5 To UBound(arr)
   
6.         If arr(i, 3) <> "" Then d(arr(i, 3)) = d(arr(i, 3)) + arr(i, 13)
   
7.     Next
   
8.     k = d.keys: it = d.items
   
9.    
   
10.     With Sheets("导入")
    
11.     brr = .Range("e6:f" & .[e65536].End(3).Row)
    
12.         For i = 1 To UBound(brr)
    
13.             For n = 0 To d.Count - 1
    
14.                 If brr(i, 1) = k(n) Then
    
15.                     brr(i, 2) = it(n): Exit For
    
16.                 End If
    
17.             Next
    
18.         Next
    
19.     .[f6].Resize(i - 1, 1).Clear
    
20.     .[f6].Resize(i - 1, 1) = Application.Index(brr, , 2)
    
21.     d.RemoveAll
    
22.     End With
    
23. End Sub

复制代码

today0427

C列编码不重复我不太清楚你的意思，实际上你有很多重复的，重复的编码我都把金额加起来了，如果不符合你的要求，那烦请再次说明一下你的要求。

su45

哦，楼上已做了，我的也做好了，还是上传下吧：

专项奖励模板03.zip (34.68 KB, 下载次数: 11)

2016-9-19 23:05 上传

点击文件名下载附件

BL123123

today0427 发表于 2016-9-19 23:00
C列编码不重复我不太清楚你的意思，实际上你有很多重复的，重复的编码我都把金额加起来了，如果不符合你的 ...

非常感谢您的解答，经测试，运行速度非常快，基本符合我的要求，C列编码不重复实际就是我新建了一个工作表将重复的合并作为一行，后边
对应的金额也进行合并处理，您的代码我测试了，发现张三  217001不知什么情况没有导入进去，麻烦您在帮忙看下，谢谢

BL123123

su45 发表于 2016-9-19 23:05
哦，楼上已做了，我的也做好了，还是上传下吧：

非常感谢您的解答，运行非常的快，非常好用，可惜最佳答案只有一个，楼上先解答的，最佳答案只能给楼上了，再次感谢您的解答。

BL123123

today0427 发表于 2016-9-19 23:00
C列编码不重复我不太清楚你的意思，实际上你有很多重复的，重复的编码我都把金额加起来了，如果不符合你的 ...

您好，我仔细看了下，原来张三的代码我写错了，所以不能导入，代码完全正确，再次感谢您的解答。