数据量太大，用vlookup非常慢，用VBA帮实现快速得到数据

ppl123

我有一个数据表，表中有近8000数据，想在数据展示表中实现按编号和对应日期展示数据，但由于数据多，使用vlookup非常的慢。请各位老师帮忙使用VBA写个代码，实现快些得到这些数据，非常感谢！！！
Book1.rar (85.95 KB, 下载次数: 57)

2018-8-14 20:58 上传

点击文件名下载附件

不知道为什么

数组和字典结合用，是不是应该会好些？

ppl123

不知道为什么 发表于 2018-8-14 21:04
数组和字典结合用，是不是应该会好些？

老师，我只会vlookup，但是太慢了

xiangbaoan

………………仅供参考………………

不知道为什么

ppl123 发表于 2018-8-14 21:05
老师，我只会vlookup，但是太慢了

如图

不知道为什么

ppl123 发表于 2018-8-14 21:05
老师，我只会vlookup，但是太慢了

代码

一指禅62

1. Sub 数据整理()
   
2.     Dim d As Object, arr, i&, j%, N%
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Sheet2.Range("G4:AZ1000").ClearContents
   
5.     For i = 4 To Sheet2.Range("F65536").End(3).Row
   
6.         d(Sheet2.Range("F" & i).Value) = i - 3
   
7.     Next
   
8.     ReDim a(1 To d.Count, 1 To 31)
   
9.     arr = Sheet1.Range("A1").CurrentRegion
   
10.     For i = 2 To UBound(arr)
    
11.         a(d.Item(arr(i, 2)), Day(arr(i, 1))) = arr(i, 3)
    
12.     Next
    
13.     If i >= 4 Then Sheet2.Range("G4").Resize(d.Count, 31) = a
    
14. End Sub

复制代码

一指禅62

Book1.rar (92.37 KB, 下载次数: 87)

2018-8-14 21:29 上传

点击文件名下载附件

lsc900707

1. Sub gj23w98()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         s = arr(i, 2) & arr(i, 1)
   
6.         d(s) = arr(i, 3)
   
7.     Next
   
8.     r = Cells(Rows.Count, 6).End(3).Row
   
9.     brr = Range("f3:ak" & r)
   
10.     For i = 2 To UBound(brr)
    
11.         For j = 2 To UBound(brr, 2)
    
12.             s = brr(i, 1) & brr(1, j)
    
13.             If d.exists(s) Then brr(i, j) = d(s)
    
14.         Next
    
15.     Next
    
16.     Range("f3:ak" & r) = brr
    
17. End Sub

复制代码