数组函数转用VBA代码（数组计算太慢）

fansong

     各位大侠，附件中我们我们公司采购订单，匹配数据中的报价记录，从中分析，哪些是选择最低报价，因为使用数组方式（报价记录60000多条）计算非常慢，时候可以使用VBA方式改变计算速度，需要改善的两列位置，我已经用颜色做了标记。
     注意：因为是匹配最低价格，原来函数的方式是多条件查询的数组。

fansong

有大伙看吗？求助急用呀！

不得已刚刚做了辅助列，用函数，但是用函数还是不大方便，希望VBA高手协助，谢谢！

fansong

发了这么久，既然没有一个人帮手呀，群内比不上前几年了，唉

liulang0808

建议楼主结合附件内容，举例描述下具体需求
不然看不明白

iwangyi

隔行如隔山，你自已清楚不等于别人明白。强化表达方式，方法，工具，如附件，举例。

xiangbaoan

Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
ar = Sheets(2).UsedRange
For r = UBound(ar) To 7 Step -1
    d1(ar(r, 3) & ar(r, 11)) = r
    d2(ar(r, 3)) = r
    d3(ar(r, 3) & ar(r, 8)) = r
Next
br = Sheets(1).UsedRange
For r = 6 To UBound(br)
    If d1.exists(br(r, 3) & br(r, 13)) Then br(r, 14) = ar(d1(br(r, 3) & br(r, 13)), 8)
    If d2.exists(br(r, 3)) Then br(r, 15) = ar(d2(br(r, 3)), 8)
    If d3.exists(br(r, 3) & br(r, 15)) Then br(r, 16) = ar(d3(br(r, 3) & br(r, 15)), 11)
    If br(r, 16) <> br(r, 13) Then br(r, 17) = "需核对" Else br(r, 17) = ""
    If br(r, 14) = br(r, 15) Then br(r, 17) = ""
Next
Sheets(1).UsedRange = br
Set d1 = Nothing
Set d2 = Nothing
Set d3 = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

xiangbaoan

…………审核中，上附件，仅供测试………………

fansong

谢谢@xiangbaoan，非常感谢