d4f8e77c66
Refactor parameter and property names from PascalCase to camelCase for consistent naming conventions across VBA modules. Changes: - Conditions → conditions (property and parameters) - Update all references across 7 modules - Maintain functional behavior while improving code readability Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
513 lines
18 KiB
QBasic
513 lines
18 KiB
QBasic
'=====================================================================
|
||
' 模块名: 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
|
||
|
||
' 提升性能：关闭屏幕更新和自动计算
|
||
Application.ScreenUpdating = False
|
||
Application.Calculation = xlCalculationManual
|
||
|
||
' 获取工作表对象
|
||
Dim orderSheet As Worksheet
|
||
Dim inventorySheet As Worksheet
|
||
Dim bomSheet As Worksheet
|
||
|
||
Set orderSheet = GetOrderSheet()
|
||
If orderSheet Is Nothing Then
|
||
RestoreAppStatus
|
||
MsgBox "未找到[产品订单]工作表!", vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
Set inventorySheet = GetInventorySheet()
|
||
If inventorySheet Is Nothing Then
|
||
RestoreAppStatus
|
||
MsgBox "未找到[现存量]工作表!", vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
Set bomSheet = GetBomSheet()
|
||
If bomSheet Is Nothing Then
|
||
RestoreAppStatus
|
||
MsgBox "未找到[平台配置清单]工作表!", vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' 检查订单数据 (调整为按C列:产品型号获取最后一行)
|
||
Dim lastRow As Long
|
||
lastRow = orderSheet.Cells(orderSheet.Rows.count, 3).End(xlUp).row
|
||
If lastRow < 2 Then
|
||
RestoreAppStatus
|
||
MsgBox "[产品订单]工作表没有数据!", vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' 【核心重构】获取筛选后的可见单元格区域 (A列)
|
||
Dim visibleRange As Range
|
||
On Error Resume Next
|
||
Set visibleRange = orderSheet.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
|
||
On Error GoTo ErrorHandler
|
||
|
||
If visibleRange Is Nothing Then
|
||
RestoreAppStatus
|
||
MsgBox "当前筛选状态下没有可见的数据。", vbInformation
|
||
Exit Sub
|
||
End If
|
||
|
||
' 初始化BOM提取器
|
||
Dim BomExtractor As BomExtractor
|
||
Set BomExtractor = New BomExtractor
|
||
BomExtractor.SetWorksheet bomSheet
|
||
|
||
If Not BomExtractor.LoadBomData Then
|
||
RestoreAppStatus
|
||
MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
|
||
Exit Sub
|
||
End If
|
||
|
||
' 读取库存数据到字典
|
||
Dim inventoryData As Object
|
||
Set inventoryData = LoadInventoryData(inventorySheet)
|
||
|
||
If inventoryData.count = 0 Then
|
||
RestoreAppStatus
|
||
MsgBox "[现存量]工作表没有有效数据!", vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' 【核心重构】传递可见区域和总行数，仅读取可见订单数据
|
||
Dim orders As Collection
|
||
Set orders = LoadOrderData(orderSheet, visibleRange, lastRow)
|
||
|
||
If orders.count = 0 Then
|
||
RestoreAppStatus
|
||
MsgBox "可见区域中没有有效的订单数据!", vbExclamation
|
||
Exit Sub
|
||
End If
|
||
|
||
' 解析所有订单的BOM
|
||
ParseAllOrdersBOM orders, BomExtractor
|
||
|
||
' 统计部件总需求
|
||
Dim componentDemands As Object
|
||
Set componentDemands = CalculateComponentDemand(orders)
|
||
|
||
If componentDemands.count = 0 Then
|
||
RestoreAppStatus
|
||
MsgBox "筛选的订单中没有包含'部件'类别物料,无需处理库存!", vbInformation
|
||
Exit Sub
|
||
End If
|
||
|
||
' 验证库存
|
||
Dim validationWarnings As Collection
|
||
Set validationWarnings = ValidateInventory(componentDemands, inventoryData)
|
||
|
||
' 按订单顺序分配库存并标记
|
||
Dim stats As Statistics
|
||
AllocateInventory orders, componentDemands, orderSheet, stats
|
||
|
||
' 恢复应用状态
|
||
RestoreAppStatus
|
||
|
||
' 输出结果统计
|
||
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:
|
||
RestoreAppStatus
|
||
MsgBox "部件库存核对异常: " & Err.Description, vbCritical
|
||
End Sub
|
||
|
||
'=====================================================================
|
||
' 辅助过程: RestoreAppStatus
|
||
' 功能: 恢复Excel应用程序的状态
|
||
'=====================================================================
|
||
Private Sub RestoreAppStatus()
|
||
Application.Calculation = xlCalculationAutomatic
|
||
Application.ScreenUpdating = True
|
||
End Sub
|
||
|
||
'=====================================================================
|
||
' 函数: LoadOrderData
|
||
' 功能: 读取订单数据
|
||
' 参数: ws - [产品订单]工作表
|
||
' 返回: Collection - 每个元素是字典对象,包含订单信息
|
||
'=====================================================================
|
||
Private Function LoadOrderData(ws As Worksheet, visibleRange As Range, lastRow As Long) As Collection
|
||
Set LoadOrderData = New Collection
|
||
|
||
' 全量读入内存数组提升速度
|
||
Dim sourceDataArr As Variant
|
||
sourceDataArr = ws.Range("A2:F" & lastRow).value
|
||
|
||
Dim cell As Range
|
||
Dim arrIndex As Long
|
||
|
||
' 仅遍历可见的单元格
|
||
For Each cell In visibleRange
|
||
Dim model As String
|
||
Dim qty As Variant
|
||
|
||
' 数组索引 = Excel行号 - 1
|
||
arrIndex = cell.row - 1
|
||
|
||
' 从内存数组中提取数据
|
||
model = Trim(sourceDataArr(arrIndex, 3)) ' C列: 产品型号
|
||
qty = sourceDataArr(arrIndex, 4) ' D列: 产品数量
|
||
|
||
' 跳过空行
|
||
If model <> "" Then
|
||
Dim order As Object
|
||
Set order = CreateObject("Scripting.Dictionary")
|
||
|
||
' 记录真实的Excel行号，用于后续库存不足时精准写入F列
|
||
order.Add ORDER_ROW, CLng(cell.row)
|
||
order.Add ORDER_MODEL, CStr(model)
|
||
order.Add ORDER_QUANTITY, CDbl(IIf(IsNull(qty) Or IsEmpty(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 cell
|
||
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
|
||
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
|
||
' --- 因为已经保存了真正的行号 ORDER_ROW, 在关闭屏幕刷新的情况下，这里直接写入是非常快的 ---
|
||
orderSheet.Cells(order(ORDER_ROW), 6).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 |