使用VBA字典快速计算材料配比

实例需求：每个工序需要多种部件，现在需要计算部件采购占比

• 如果只有一个供货商，那么占比为100%【参见绿色行】
• 如果有多个供货商，那么最低价供货商占比为70%，最高价供货商占比为30%【参见黄色区域】
• 不考虑两个部件单价相同的清空
• 原料列中部分数据包含@，可以忽略，即@2和2是相同的原料

示例代码如下。

Private Sub Demo()
    Dim arrData, strKey
    Dim DicMax As Object, DicMin As Object
    Set DicMax = CreateObject("scripting.dictionary")
    Set DicMin = CreateObject("scripting.dictionary")
    Columns(4).ClearContents
    [d1] = "占比"
    arrData = Range("a1").CurrentRegion
    For i = 2 To UBound(arrData)
        strKey = Trim(arrData(i, 1)) & Replace(Trim(arrData(i, 2)), "@", "")
        If Not DicMax.exists(strKey) Then
            DicMax(strKey) = i
            DicMin(strKey) = i
        Else
            If arrData(i, 3) > arrData(DicMax(strKey), 3) Then DicMax(strKey) = i
            If arrData(i, 3) < arrData(DicMin(strKey), 3) Then DicMin(strKey) = i
        End If
    Next
    For Each strKey In DicMax.Keys
        arrData(DicMax(strKey), 4) = 0.3
    Next
    For Each strKey In DicMin.Keys
        arrData(DicMin(strKey), 4) = arrData(DicMin(strKey), 4) + 0.7
    Next
    Range("a1").CurrentRegion.Value = arrData
    Set DicMin = Nothing
    Set DicMax = Nothing
End Sub

【代码解析】
第4~5行代码创建两个字典对象，分别用于保存对应工序原料的最大单价和最小单价所在行。
第6行代码清空D列数据。
第7行代码将数据读取到数组中。
第8~17行代码循环处理数据行。
第9行代码将工序+原料作为键值，其中使用Replace清除原料编号前的@。
如果字典中不存在键值，那么第11~12行代码将行号保存到DicMax和DicMin中，此时最大值和最小值行号相同。
如果字典中存在相同键值，并且单价大于最大值对应的行的单价，第14行代码将当前行行号更新到DicMax中。
与此类似，第15行代码更新最小值行号到DicMin中。
第18~20行代码循环遍历DicMax，将对应部件的占比设置为30%。
第21~23行代码循环遍历DicMin，将对应部件的占比设置为70%，如果工序+原料只有一行记录，那么其占比将为100%。
第22行代码并未进行判断，而是直接采用了相加的方法，可以用单行代码实现相同的效果。
第24行代码将数据回写到单元格区域中。
第25~26行代码清空对象变量占用的系统资源。