请大神帮忙实现个查询定价的功能。用公式太卡了。Excel会卡死。

看脱了色彩

昨天晚上论坛好像坏了。等到凌晨1点都不能发帖！只有今天再来求助。
我在【函数与公式】板块也发了求助，但最好是能在 VBA 里实现。所以请帮忙看看！谢谢
我有个查询公式，但是这个公式用多了。Excel 输入内容就卡死了。可能查询的内容太多了。但是自己又想不到办法。希望大神帮忙改进下。感谢！！！！

查询值是这一段【SUM(SUMIF(INDIRECT("供应商"&{1,2,3}&"!A:BB"),S6,INDIRECT("供应商"&{1,2,3}&"!B1")))】，但是要根据查询结果来做相关处理。
公式是这样的 【=ROUND(IF(X>=6,X+定价表!$B$6,IF(X>=4,X+定价表!$B$7,IF(X>=2,X+定价表!$B$8,X*(1+定价表!$B$9%)))),2)】

如果把 X 替换成那段公式，表格输入值就要卡死。

附件如下。(重新上传)
定价文档.rar (65.52 KB, 下载次数: 12)

2020-2-12 15:12 上传

点击文件名下载附件

凌空一羽

Sub lkyy()
Dim sht As Worksheet
Set d = CreateObject("Scripting.Dictionary")
For Each sht In Sheets
    If Left(sht.Name, 3) = "供应商" Then
        ar = sht.Range("a1:am100")
        For j = 1 To 36 Step 5
            For i = 3 To 100
                If ar(i, j) <> "" Then d(ar(i, j)) = d(ar(i, j)) + ar(i, j + 1)
            Next
        Next
    End If
Next
For j = 1 To 4
    For i = 3 To 49
        t = Cells(i, j * 6 - 5)
        If t <> "" Then
            If d.exists(t) Then
                x = d(t): y = 0
                Select Case x
                    Case Is >= 6
                    y = x + Sheets("定价表").[b6]
                    Case Is >= 4
                    y = x + Sheets("定价表").[b7]
                    Case Is >= 2
                    y = x + Sheets("定价表").[b8]
                    Case Else
                    y = x * (1 + Sheets("定价表").[b8] / 100)
                End Select
                Cells(i, j * 6 - 2) = y
            End If
        End If
    Next
Next
Set d = Nothing
End Sub

看脱了色彩

凌空一羽 发表于 2020-2-12 14:27
Sub lkyy()
Dim sht As Worksheet
Set d = CreateObject("Scripting.Dictionary")

不行啊，大佬。在“供货商”表里填了单价，在sheet1 不显示出来。
我重新注释了需要的功能，重传了附件。麻烦你再帮忙看看。！！！！

蓝桥玄霜

单价的例子：
删除单价列里面的公式，输入代码，执行代码即可。

看脱了色彩

蓝桥玄霜 发表于 2020-2-12 16:14
单价的例子：
删除单价列里面的公式，输入代码，执行代码即可。

你是个好老师，必须让学生亲自抄写一次。