Files
AutoBOM/VBA/Modules/ComponentInventoryCheckModule.bas
Misaka_Company dd6ae4c005 feat: add component inventory check module
Implement automatic component inventory verification that marks
orders with insufficient stock as "Component Priority = No".

Key features:
- Reads orders from [产品订单] worksheet
- Parses BOM to identify component category materials
- Validates inventory against [现存量] worksheet
- Allocates stock in order sequence
- Handles missing components with warnings instead of errors
- Provides detailed statistics on completion

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-02 17:55:08 +08:00

471 lines
16 KiB
QBasic
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
'=====================================================================
' 模块名: ComponentInventoryCheckModule
' 功能: 部件库存核对模块 - 自动核对产品订单中"部件"类物料的库存情况
' 说明: 当库存不足时,按订单顺序将超出部分的订单的"部件优先"字段标记为"否"
'=====================================================================
Option Explicit
'=====================================================================
' 数据结构定义 - 使用字典以支持引用更新
'=====================================================================
' 订单字典键
Private Const ORDER_ROW As String = "RowNumber"
Private Const ORDER_MODEL As String = "ProductModel"
Private Const ORDER_QUANTITY As String = "Quantity"
Private Const ORDER_COMP_CODE As String = "ComponentCode"
Private Const ORDER_COMP_QTY As String = "ComponentQty"
Private Const ORDER_HAS_COMP As String = "HasComponent"
Private Const ORDER_PARSE_ERR As String = "ParseError"
' 部件库存字典键
Private Const INV_CODE As String = "ComponentCode"
Private Const INV_DEMAND As String = "TotalDemand"
Private Const INV_STOCK As String = "AvailableStock"
Private Const INV_SHORTAGE As String = "IsShortage"
' 统计信息结构
Private Type Statistics
TotalOrders As Long ' 总订单数
OrdersWithComponent As Long ' 包含部件的订单数
OrdersSufficient As Long ' 库存充足订单数
OrdersInsufficient As Long ' 库存不足订单数
OrdersSkipped As Long ' 跳过订单数
End Type
'=====================================================================
' 主入口程序
'=====================================================================
Public Sub CheckComponentInventory()
On Error GoTo ErrorHandler
Dim startTime As Double
startTime = Timer
' 获取工作表对象
Dim orderSheet As Worksheet
Dim inventorySheet As Worksheet
Dim bomSheet As Worksheet
Set orderSheet = GetOrderSheet()
If orderSheet Is Nothing Then
MsgBox "未找到[产品订单]工作表!", vbExclamation
Exit Sub
End If
Set inventorySheet = GetInventorySheet()
If inventorySheet Is Nothing Then
MsgBox "未找到[现存量]工作表!", vbExclamation
Exit Sub
End If
Set bomSheet = GetBomSheet()
If bomSheet Is Nothing Then
MsgBox "未找到[平台配置清单]工作表!", vbExclamation
Exit Sub
End If
' 检查订单数据
Dim lastRow As Long
lastRow = orderSheet.Cells(orderSheet.Rows.Count, 2).End(xlUp).Row
If lastRow < 2 Then
MsgBox "[产品订单]工作表没有数据!", vbExclamation
Exit Sub
End If
' 初始化BOM提取器
Dim bomExtractor As BomExtractor
Set bomExtractor = New BomExtractor
bomExtractor.SetWorksheet bomSheet
If Not bomExtractor.LoadBomData Then
MsgBox "加载BOM数据失败:" & bomExtractor.GetErrorSummary, vbCritical
Exit Sub
End If
' 读取库存数据到字典
Dim inventoryData As Object
Set inventoryData = LoadInventoryData(inventorySheet)
If inventoryData.Count = 0 Then
MsgBox "[现存量]工作表没有有效数据!", vbExclamation
Exit Sub
End If
' 读取订单数据
Dim orders As Collection
Set orders = LoadOrderData(orderSheet)
If orders.Count = 0 Then
MsgBox "没有有效的订单数据!", vbExclamation
Exit Sub
End If
' 解析所有订单的BOM
ParseAllOrdersBOM orders, bomExtractor
' 统计部件总需求
Dim componentDemands As Object
Set componentDemands = CalculateComponentDemand(orders)
If componentDemands.Count = 0 Then
MsgBox "没有订单包含'部件'类别物料,无需处理库存!", vbInformation
Exit Sub
End If
' 验证库存
Dim validationWarnings As Collection
Set validationWarnings = ValidateInventory(componentDemands, inventoryData)
' 按订单顺序分配库存
Dim stats As Statistics
AllocateInventory orders, componentDemands, orderSheet, stats
' 输出结果统计
Dim elapsedTime As Double
elapsedTime = Timer - startTime
Dim resultMsg As String
resultMsg = "部件库存核对完成!" & vbCrLf & vbCrLf
resultMsg = resultMsg & "处理订单数: " & stats.TotalOrders & vbCrLf
resultMsg = resultMsg & "包含部件订单: " & stats.OrdersWithComponent & vbCrLf
resultMsg = resultMsg & "库存充足订单: " & stats.OrdersSufficient & vbCrLf
resultMsg = resultMsg & "库存不足订单: " & stats.OrdersInsufficient & vbCrLf
If stats.OrdersSkipped > 0 Then
resultMsg = resultMsg & "跳过订单数: " & stats.OrdersSkipped & vbCrLf
End If
resultMsg = resultMsg & vbCrLf & "耗时: " & Format(elapsedTime, "0.00") & "秒"
' 显示警告信息(如果有)
If validationWarnings.Count > 0 Then
resultMsg = resultMsg & vbCrLf & vbCrLf & "警告信息:" & vbCrLf
resultMsg = resultMsg & JoinCollection(validationWarnings, vbCrLf)
End If
MsgBox resultMsg, vbInformation
Exit Sub
ErrorHandler:
MsgBox "部件库存核对异常: " & Err.Description, vbCritical
End Sub
'=====================================================================
' 函数: LoadOrderData
' 功能: 读取订单数据
' 参数: ws - [产品订单]工作表
' 返回: Collection - 每个元素是字典对象,包含订单信息
'=====================================================================
Private Function LoadOrderData(ws As Worksheet) As Collection
Set LoadOrderData = New Collection
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
Dim i As Long
For i = 2 To lastRow
Dim model As String
Dim qty As Variant
model = Trim(ws.Cells(i, 2).Value) ' B列: 产品型号
qty = ws.Cells(i, 3).Value ' C列: 产品数量
' 跳过空行
If model <> "" Then
Dim order As Object
Set order = CreateObject("Scripting.Dictionary")
order.Add ORDER_ROW, CLng(i)
order.Add ORDER_MODEL, CStr(model)
order.Add ORDER_QUANTITY, CDbl(IIf(IsNull(qty), 0, qty))
order.Add ORDER_COMP_CODE, ""
order.Add ORDER_COMP_QTY, 0
order.Add ORDER_HAS_COMP, False
order.Add ORDER_PARSE_ERR, ""
LoadOrderData.Add order
End If
Next i
End Function
'=====================================================================
' 函数: LoadInventoryData
' 功能: 读取库存数据
' 参数: ws - [现存量]工作表
' 返回: Dictionary(物料编码 -> 库存数量)
'=====================================================================
Private Function LoadInventoryData(ws As Worksheet) As Object
Set LoadInventoryData = CreateObject("Scripting.Dictionary")
' 从第4行开始读取(第3行是表头)
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
Dim i As Long
For i = 4 To lastRow
Dim code As String
Dim qty As Variant
code = Trim(ws.Cells(i, 2).Value) ' B列: 物料编码
qty = ws.Cells(i, 10).Value ' J列: 结存主数量
If code <> "" And Not IsEmpty(qty) Then
If Not LoadInventoryData.Exists(code) Then
LoadInventoryData.Add code, CDbl(qty)
End If
End If
Next i
End Function
'=====================================================================
' 过程: ParseAllOrdersBOM
' 功能: 解析所有订单的BOM
' 参数: orders - 订单集合(每个元素是字典)
' bomExtractor - BOM提取器
'=====================================================================
Private Sub ParseAllOrdersBOM(orders As Collection, bomExtractor As BomExtractor)
Dim i As Long
For i = 1 To orders.Count
Dim order As Object
Set order = orders(i)
ParseOrderBOM order, bomExtractor
Next i
End Sub
'=====================================================================
' 过程: ParseOrderBOM
' 功能: 解析单个订单的BOM,识别部件类别物料
' 参数: orderInfo - 订单信息字典(ByRef)
' bomExtractor - BOM提取器
'=====================================================================
Private Sub ParseOrderBOM(ByRef orderInfo As Object, bomExtractor As BomExtractor)
On Error Resume Next
' 解析型号
Dim parser As ProductModelParser
Set parser = New ProductModelParser
If Not parser.Parse(orderInfo(ORDER_MODEL)) Then
orderInfo(ORDER_PARSE_ERR) = "解析失败: " & parser.ErrorMessage
Exit Sub
End If
' 提取BOM
Dim matchedItems As Collection
Set matchedItems = bomExtractor.ExtractBom(parser.Conditions)
' 查找"部件"类别物料
Dim item As BomItem
For Each item In matchedItems
If item.category = "部件" Then
orderInfo(ORDER_COMP_CODE) = item.Code66
orderInfo(ORDER_COMP_QTY) = item.quantity
orderInfo(ORDER_HAS_COMP) = True
Exit For
End If
Next item
End Sub
'=====================================================================
' 函数: CalculateComponentDemand
' 功能: 统计部件总需求
' 参数: orders - 订单集合
' 返回: Dictionary(部件编码 -> 库存信息字典)
'=====================================================================
Private Function CalculateComponentDemand(orders As Collection) As Object
Dim demands As Object
Set demands = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 1 To orders.Count
Dim order As Object
Set order = orders(i)
If order(ORDER_HAS_COMP) Then
Dim demand As Double
demand = order(ORDER_COMP_QTY) * order(ORDER_QUANTITY)
Dim compCode As String
compCode = order(ORDER_COMP_CODE)
If demands.Exists(compCode) Then
Dim compInv As Object
Set compInv = demands(compCode)
compInv(INV_DEMAND) = compInv(INV_DEMAND) + demand
Else
Dim newComp As Object
Set newComp = CreateObject("Scripting.Dictionary")
newComp.Add INV_CODE, compCode
newComp.Add INV_DEMAND, demand
newComp.Add INV_STOCK, 0
newComp.Add INV_SHORTAGE, False
demands.Add compCode, newComp
End If
End If
Next i
Set CalculateComponentDemand = demands
End Function
'=====================================================================
' 函数: ValidateInventory
' 功能: 验证库存数据
' 参数: componentDemands - 部件需求字典
' inventoryData - 库存数据字典
' 返回: Collection - 警告信息集合(找不到的部件)
'=====================================================================
Private Function ValidateInventory(componentDemands As Object, _
inventoryData As Object) As Collection
Set ValidateInventory = New Collection
Dim code As Variant
For Each code In componentDemands.Keys
Dim compInv As Object
Set compInv = componentDemands(code)
' 检查库存中是否存在该部件
If Not inventoryData.Exists(compInv(INV_CODE)) Then
' 库存中找不到设置库存为0并添加警告
compInv(INV_STOCK) = 0
compInv(INV_SHORTAGE) = True
ValidateInventory.Add "部件 '" & compInv(INV_CODE) & "' 在[现存量]中未找到"
Else
' 设置可用库存
compInv(INV_STOCK) = inventoryData(compInv(INV_CODE))
' 检查是否短缺
If compInv(INV_DEMAND) > compInv(INV_STOCK) Then
compInv(INV_SHORTAGE) = True
End If
End If
Next code
End Function
'=====================================================================
' 过程: AllocateInventory
' 功能: 按订单顺序分配库存并标记
' 参数: orders - 订单集合
' componentDemands - 部件需求字典
' orderSheet - 订单工作表
' stats - 统计信息(ByRef)
'=====================================================================
Private Sub AllocateInventory(orders As Collection, _
componentDemands As Object, _
orderSheet As Worksheet, _
ByRef stats As Statistics)
' 初始化统计
stats.TotalOrders = orders.Count
stats.OrdersWithComponent = 0
stats.OrdersSufficient = 0
stats.OrdersInsufficient = 0
stats.OrdersSkipped = 0
Dim i As Long
For i = 1 To orders.Count
Dim order As Object
Set order = orders(i)
' 跳过解析失败的订单
If order(ORDER_PARSE_ERR) <> "" Then
stats.OrdersSkipped = stats.OrdersSkipped + 1
GoTo NextOrder
End If
' 跳过没有部件的订单
If Not order(ORDER_HAS_COMP) Then
stats.OrdersSkipped = stats.OrdersSkipped + 1
GoTo NextOrder
End If
' 跳过数量为0的订单
If order(ORDER_QUANTITY) = 0 Then
stats.OrdersSkipped = stats.OrdersSkipped + 1
GoTo NextOrder
End If
stats.OrdersWithComponent = stats.OrdersWithComponent + 1
' 获取部件库存信息
Dim compInv As Object
Set compInv = componentDemands(order(ORDER_COMP_CODE))
' 计算需求量
Dim requiredQty As Double
requiredQty = order(ORDER_COMP_QTY) * order(ORDER_QUANTITY)
' 检查库存是否充足
If compInv(INV_STOCK) >= requiredQty Then
' 库存充足,扣减库存,保持原值
compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
stats.OrdersSufficient = stats.OrdersSufficient + 1
Else
' 库存不足,标记为"否"
orderSheet.Cells(order(ORDER_ROW), 5).Value = "否"
compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty
stats.OrdersInsufficient = stats.OrdersInsufficient + 1
End If
NextOrder:
Next i
End Sub
'=====================================================================
' 函数: GetOrderSheet
' 功能: 获取[产品订单]工作表
' 返回: Worksheet
'=====================================================================
Private Function GetOrderSheet() As Worksheet
On Error Resume Next
Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单")
On Error GoTo 0
End Function
'=====================================================================
' 函数: GetInventorySheet
' 功能: 获取[现存量]工作表
' 返回: Worksheet
'=====================================================================
Private Function GetInventorySheet() As Worksheet
On Error Resume Next
Set GetInventorySheet = ThisWorkbook.Worksheets("现存量")
On Error GoTo 0
End Function
'=====================================================================
' 函数: GetBomSheet
' 功能: 获取[平台配置清单]工作表
' 返回: Worksheet
'=====================================================================
Private Function GetBomSheet() As Worksheet
On Error Resume Next
Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单")
On Error GoTo 0
End Function
'=====================================================================
' 函数: JoinCollection
' 功能: 将集合内容连接为字符串
' 参数: coll - 集合
' separator - 分隔符
' 返回: String
'=====================================================================
Private Function JoinCollection(coll As Collection, separator As String) As String
Dim result As String
result = ""
Dim item As Variant
Dim isFirst As Boolean
isFirst = True
For Each item In coll
If Not isFirst Then
result = result & separator
End If
result = result & CStr(item)
isFirst = False
Next item
JoinCollection = result
End Function