[已解决]寻求vba类似字典等快速解决方法

的发放给

根据供应商和物料号查找最新的采购单价，请考虑数据量庞大的情况（几十万行的数据），请考虑没有按照日期排序的情况

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-8-25 16:35

不考虑同一天有相同料号单价时，以下代码。

1. Sub aaa()
   
2. Dim arr, brr, i&, d As Object, s$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets(1).[a1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.   s = arr(i, 2) & "," & arr(i, 3)
   
7.   If Not d.exists(s) Then d(s) = Array(arr(i, 4), arr(i, 1))
   
8.   If d(s)(1) < arr(i, 1) Then
   
9.     brr = d(s)
   
10.     brr(0) = arr(i, 4)
    
11.     brr(1) = arr(i, 1)
    
12.     d(s) = brr
    
13.   End If
    
14. Next i
    
15. arr = Sheets(2).Range("a2:b" & Sheets(2).Cells(Rows.Count, 1).End(3).Row)
    
16. ReDim Preserve arr(1 To UBound(arr), 1 To 3)
    
17. For i = 1 To UBound(arr)
    
18.   arr(i, 3) = d(arr(i, 1) & "," & arr(i, 2))(0)
    
19. Next i
    
20. Sheets(2).[c2].Resize(UBound(arr)) = Application.Index(arr, , 3)
    
21. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

相同供应商和物料号，最新日期是同一天怎么判断取哪个？

大灰狼1976

不考虑同一天有相同料号单价时，以下代码。

1. Sub aaa()
   
2. Dim arr, brr, i&, d As Object, s$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets(1).[a1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.   s = arr(i, 2) & "," & arr(i, 3)
   
7.   If Not d.exists(s) Then d(s) = Array(arr(i, 4), arr(i, 1))
   
8.   If d(s)(1) < arr(i, 1) Then
   
9.     brr = d(s)
   
10.     brr(0) = arr(i, 4)
    
11.     brr(1) = arr(i, 1)
    
12.     d(s) = brr
    
13.   End If
    
14. Next i
    
15. arr = Sheets(2).Range("a2:b" & Sheets(2).Cells(Rows.Count, 1).End(3).Row)
    
16. ReDim Preserve arr(1 To UBound(arr), 1 To 3)
    
17. For i = 1 To UBound(arr)
    
18.   arr(i, 3) = d(arr(i, 1) & "," & arr(i, 2))(0)
    
19. Next i
    
20. Sheets(2).[c2].Resize(UBound(arr)) = Application.Index(arr, , 3)
    
21. End Sub

复制代码

的发放给

大灰狼1976 发表于 2017-8-25 16:34
相同供应商和物料号，最新日期是同一天怎么判断取哪个？

感谢哈，最新日期是同一天的话，取哪个值都可以的；在同一天里面，相同供应商和物料号，不可能出现多个价格的，所以随便去一个就好了

大灰狼1976

那试下我楼上贴的代码吧。