欢迎转发和点一下“在看”，文末留言互动!
置顶公众号或设为星标及时接收更新不迷路
朋友们你好，这里是EXCEL应用之家，坚持分享EXCEL操作技巧。
今天来和大家分享一道供应链的问题，如何根据订单数量、库存和BOM表来计算缺件数量。
原题是这样的：
根据提供的信息计算出缺料的名称及数量，模拟答案写在了K列。
这时非常常见的一道实际应用题目。通过VBA字典方法，可以很好的处理它，并生成模版以供日后批量处理类似的问题。
01
VBA字典方法
完整代码如下：
Sub 计算缺料() Dim i%, j%, k%, m%, s As String Dim arr As Variant, brr As Variant, crr As Variant, drr As Variant Dim mydic As Object, 产品 As String, 订单数量 As Integer ReDim drr(1 To 2, 1 To 1) arr = Range("A2:C13"): brr = Range("E2:F10"): crr = Range("I3:J4") Set mydic = CreateObject("scripting.dictionary") For i = 1 To UBound(brr) mydic(brr(i, 1)) = brr(i, 2) Next For i = 1 To UBound(crr) 产品 = crr(i, 1): 订单数量 = crr(i, 2) For j = 1 To UBound(arr) If arr(j, 1) <> "" Then k = j If arr(k, 1) = 产品 And mydic.exists(arr(j, 2)) Then m = mydic(arr(j, 2)) - 订单数量 * arr(j, 3) mydic(arr(j, 2)) = mydic(arr(j, 2)) - 订单数量 * arr(j, 3) If m < 0 Then s = s & "," & arr(j, 2) & m End If Next drr(i, 1) = Mid(s, 2): s = "" Next [K3].Resize(UBound(drr), 1) = drrEnd Sub
下面来讲一讲这段代码。
Set mydic = CreateObject("scripting.dictionary")For i = 1 To UBound(brr) mydic(brr(i, 1)) = brr(i, 2)Next
创建并装入字典。配件名称为键，库存数量为键值。
For i = 1 To UBound(crr) 产品 = crr(i, 1): 订单数量 = crr(i, 2)
对订单循环。设置“产品”和“订单数量”这两个变量。
For j = 1 To UBound(arr)
对BOM表循环。
If arr(j, 1) <> "" Then k = j
常用技巧。变量k决定了在BOM表中循环到哪一个产品。
If arr(k, 1) = 产品 And mydic.exists(arr(j, 2)) Then m = mydic(arr(j, 2)) - 订单数量 * arr(j, 3) mydic(arr(j, 2)) = mydic(arr(j, 2)) - 订单数量 * arr(j, 3) If m < 0 Then s = s & "," & arr(j, 2) & mEnd If
如果BOM表中当前的产品等于订单中的产品，且配件在字典中时，就用库存减去消耗量（订单数量乘以BOM的用量），并将结余赋值给变量m。
同时也将结余赋值给字典对应的键。
如果变量m的值小于0了，那就表明有缺件了，那就按照“配件-数量”的格式将结果赋值给变量s。
通过变量j的循环，可以将所有的缺件及数量都组合为字符串复制给变量s。
drr(i, 1) = Mid(s, 2): s = ""
对数组drr赋值，同时令变量s为空，开始下一个循环。
[K3].Resize(UBound(drr), 1) = drr
最终结果输出。
这段代码虽然结果符合要求，但在实际工作中我们不会这样做的。现实中最合理的做法是输出一份缺料清单，列明产品-配件-缺料数量的对应关系。
02
更符合现实意义的缺料表
现实工作中输出一份如下列的缺料表更有实际意义。
因此代码可以这样写。
完整代码如下：
Sub 计算缺料1() Dim i%, j%, k%, m%, n% Dim arr As Variant, brr As Variant, crr As Variant, drr As Variant Dim mydic As Object, 产品, 订单数量 Set mydic = CreateObject("scripting.dictionary") arr = Range("A2:C13"): brr = Range("E2:F10"): crr = Range("I3:J4") ReDim drr(1 To 30, 1 To 3) For i = 1 To UBound(brr) mydic(brr(i, 1)) = brr(i, 2) Next For i = 1 To UBound(crr) 产品 = crr(i, 1): 订单数量 = crr(i, 2) For j = 1 To UBound(arr) If arr(j, 1) <> "" Then k = j If arr(k, 1) = 产品 And mydic.exists(arr(j, 2)) Then m = mydic(arr(j, 2)) - 订单数量 * arr(j, 3) mydic(arr(j, 2)) = mydic(arr(j, 2)) - 订单数量 * arr(j, 3) If m < 0 Then n = n + 1 drr(n, 1) = 产品 drr(n, 2) = arr(j, 2) drr(n, 3) = -m End If End If Next Next [L2].Resize(1, 3) = Array("产品", "配件", "缺件数量") [L3].Resize(UBound(drr), 3) = drrEnd Sub
这段代码和前面一段不同之处在下面。
If m < 0 Then n = n + 1 drr(n, 1) = 产品 drr(n, 2) = arr(j, 2) drr(n, 3) = -mEnd If
当变量m小于0时，依次将“产品”、“品名”和“数量”赋值给数组drr，生成一份完整的缺料清单。
好了，大功告成，找双儿去喽~~
我就知道你“在看”