867b1979af
All checks were successful
NTFY Notification / notify (push) Successful in 3s
- Add BOM library column name constants (名称, 编码, 数量, etc.) - Add GetBOMConditionFields() and IsConditionField() utility functions - Refactor ExtractMaterialInfo to use column names instead of hardcoded positions - Refactor ExtractSingleSubComponent to use column names for 接头/弹性元件 - Refactor ExtractComponentInfo to use column names - Improve MatchAllMaterialTypes to iterate all worksheets dynamically - Add debug logging for troubleshooting This fix resolves issues where worksheets with non-standard column counts (like 表壳, 罩壳) could not extract material information properly. Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
507 lines
16 KiB
QBasic
507 lines
16 KiB
QBasic
' ==============================================================================
|
||
' 模块: M08_ComponentProcessor
|
||
' 职责: 处理"部件"物料的特殊逻辑
|
||
'
|
||
' 部件物料特性:
|
||
' - 每条"部件"记录包含三个物料的数据：
|
||
' 1. 部件物料本身
|
||
' 2. 接头物料（子件1）
|
||
' 3. 弹性元件物料（子件2）
|
||
'
|
||
' 选择策略:
|
||
' - 优先选择"部件"物料
|
||
' - 当"部件"物料库存不足时，选择"接头"+"弹性元件"
|
||
' - 库存检查接口预留，当前默认返回True（库存充足）
|
||
'
|
||
' 验证规则:
|
||
' - 正常组合1: 1个部件
|
||
' - 正常组合2: 1个接头 + 1个弹性元件
|
||
' - 异常: 其他组合（如只有接头、只有弹性元件、同时有部件和接头等）
|
||
' ==============================================================================
|
||
Option Explicit
|
||
|
||
' 模块级变量 - 错误记录器
|
||
Private g_Logger As clsErrorLogger
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 初始化部件处理器
|
||
' ------------------------------------------------------------------------------
|
||
Public Sub InitComponentProcessor(logger As clsErrorLogger)
|
||
Set g_Logger = logger
|
||
End Sub
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 主入口: 处理"部件"记录，返回物料集合
|
||
'
|
||
' 输入:
|
||
' wsComponent - "部件"工作表
|
||
' params - 从产品型号中提取的参数字典
|
||
' logger - 错误记录器
|
||
'
|
||
' 输出:
|
||
' Collection - 物料集合
|
||
' 每个元素是一个字典，包含: materialName, materialCode, materialQty, materialType, remarks
|
||
'
|
||
' 逻辑流程:
|
||
' 1. 在"部件"工作表中查找匹配记录
|
||
' 2. 如果恰好匹配1条:
|
||
' a. 检查"部件"物料库存
|
||
' b. 如果有库存，返回部件物料
|
||
' c. 如果无库存，提取子件（接头+弹性元件）
|
||
' 3. 如果未匹配或多条匹配，记录错误
|
||
'
|
||
' 示例:
|
||
' Set materials = ProcessComponentRecord(wsComponent, params, logger)
|
||
' ' materials(1) - 部件物料 或 接头物料
|
||
' ' materials(2) - 弹性元件物料（如果选择子件）
|
||
' ------------------------------------------------------------------------------
|
||
Public Function ProcessComponentRecord( _
|
||
ByVal wsComponent As Worksheet, _
|
||
ByVal params As Object, _
|
||
ByVal logger As clsErrorLogger _
|
||
) As Collection
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim materials As Collection
|
||
Set materials = New Collection
|
||
|
||
' 步骤1: 在"部件"工作表中查找匹配记录
|
||
Dim matchResult As Object
|
||
Set matchResult = M07_BOMMatcher.MatchBOMRecord(wsComponent, params)
|
||
|
||
' 步骤2: 判断匹配结果
|
||
If Not matchResult("success") Then
|
||
' 匹配失败（0条或多条），记录错误
|
||
Dim errorMaterial As Object
|
||
Set errorMaterial = CreateObject("Scripting.Dictionary")
|
||
errorMaterial("materialType") = "部件"
|
||
errorMaterial("materialName") = ""
|
||
errorMaterial("materialCode") = ""
|
||
errorMaterial("materialQty") = 0
|
||
errorMaterial("remarks") = matchResult("message")
|
||
materials.Add errorMaterial
|
||
|
||
Set ProcessComponentRecord = materials
|
||
Exit Function
|
||
End If
|
||
|
||
' 步骤3: 获取匹配的行号
|
||
Dim rowNum As Long
|
||
rowNum = matchResult("rowNums")(1)
|
||
|
||
' 步骤4: 构建表头映射
|
||
Dim headerMap As Object
|
||
Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(wsComponent)
|
||
|
||
' 步骤5: 检查部件库存
|
||
If CheckComponentInventory(wsComponent, rowNum, headerMap) Then
|
||
' 库存充足，返回部件物料
|
||
Dim componentInfo As Object
|
||
Set componentInfo = ExtractComponentInfo(wsComponent, rowNum, headerMap, "部件")
|
||
|
||
If Not componentInfo Is Nothing Then
|
||
materials.Add componentInfo
|
||
End If
|
||
Else
|
||
' 库存不足，提取子件（接头+弹性元件）
|
||
Dim subComponents As Collection
|
||
Set subComponents = ExtractSubComponents(wsComponent, rowNum, headerMap)
|
||
|
||
Dim subComp As Variant
|
||
For Each subComp In subComponents
|
||
materials.Add subComp
|
||
Next subComp
|
||
End If
|
||
|
||
Set ProcessComponentRecord = materials
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
If Not logger Is Nothing Then
|
||
logger.Record 0, "M08.ProcessComponentRecord", "SystemError", _
|
||
"处理部件记录失败: " & Err.Description, ""
|
||
End If
|
||
|
||
' 返回错误物料
|
||
Dim errorMat As Object
|
||
Set errorMat = CreateObject("Scripting.Dictionary")
|
||
errorMat("materialType") = "部件"
|
||
errorMat("materialName") = ""
|
||
errorMat("materialCode") = ""
|
||
errorMat("materialQty") = 0
|
||
errorMat("remarks") = "系统错误: " & Err.Description
|
||
|
||
Dim errorCol As New Collection
|
||
errorCol.Add errorMat
|
||
Set ProcessComponentRecord = errorCol
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 检查部件库存状态（预留接口）
|
||
'
|
||
' 输入:
|
||
' wsComponent - "部件"工作表
|
||
' rowNum - 匹配到的行号
|
||
' headerMap - 表头映射
|
||
'
|
||
' 输出:
|
||
' Boolean - True表示有库存，False表示无库存
|
||
'
|
||
' 注意:
|
||
' - 当前版本默认返回True（库存充足）
|
||
' - 预留接口，未来可连接ERP/库存系统
|
||
' - 可扩展为查询库存Excel表或API
|
||
' ------------------------------------------------------------------------------
|
||
Private Function CheckComponentInventory( _
|
||
ByVal wsComponent As Worksheet, _
|
||
ByVal rowNum As Long, _
|
||
ByVal headerMap As Object _
|
||
) As Boolean
|
||
' TODO: 连接库存系统查询实际库存
|
||
' 当前版本默认返回True（库存充足）
|
||
|
||
' 示例扩展代码（注释）:
|
||
' If headerMap.Exists("库存数量") Then
|
||
' Dim stockQty As Long
|
||
' stockQty = CLng(wsComponent.Cells(rowNum, headerMap("库存数量")).Value)
|
||
' CheckComponentInventory = (stockQty > 0)
|
||
' Else
|
||
' CheckComponentInventory = True
|
||
' End If
|
||
|
||
CheckComponentInventory = True
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 提取部件物料信息
|
||
'
|
||
' 输入:
|
||
' wsComponent - "部件"工作表
|
||
' rowNum - 匹配到的行号
|
||
' headerMap - 表头映射
|
||
' componentType - 部件类型（"部件"）
|
||
'
|
||
' 输出:
|
||
' Object (Scripting.Dictionary) - 部件物料信息
|
||
' 键值对: materialName, materialCode, materialQty, materialType, remarks
|
||
' ------------------------------------------------------------------------------
|
||
Private Function ExtractComponentInfo( _
|
||
ByVal wsComponent As Worksheet, _
|
||
ByVal rowNum As Long, _
|
||
ByVal headerMap As Object, _
|
||
ByVal componentType As String _
|
||
) As Object
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim componentInfo As Object
|
||
Set componentInfo = CreateObject("Scripting.Dictionary")
|
||
componentInfo("materialType") = componentType
|
||
|
||
' 通过列名常量查找物料信息列
|
||
Dim nameKey As String, codeKey As String, qtyKey As String
|
||
nameKey = LCase(BOMLIB_COL_NAME)
|
||
codeKey = LCase(BOMLIB_COL_CODE)
|
||
qtyKey = LCase(BOMLIB_COL_QTY)
|
||
|
||
' 查找物料名称列
|
||
If headerMap.Exists(nameKey) Then
|
||
Dim nameCol As Long
|
||
nameCol = headerMap(nameKey)
|
||
componentInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, nameCol).Value))
|
||
Else
|
||
componentInfo("materialName") = ""
|
||
End If
|
||
|
||
' 查找物料编码列
|
||
If headerMap.Exists(codeKey) Then
|
||
Dim codeCol As Long
|
||
codeCol = headerMap(codeKey)
|
||
componentInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, codeCol).Value))
|
||
Else
|
||
componentInfo("materialCode") = ""
|
||
End If
|
||
|
||
' 查找物料数量列
|
||
If headerMap.Exists(qtyKey) Then
|
||
Dim qtyCol As Long
|
||
qtyCol = headerMap(qtyKey)
|
||
Dim qtyValue As Variant
|
||
qtyValue = wsComponent.Cells(rowNum, qtyCol).Value
|
||
If IsNumeric(qtyValue) Then
|
||
componentInfo("materialQty") = CLng(qtyValue)
|
||
Else
|
||
componentInfo("materialQty") = 1
|
||
End If
|
||
Else
|
||
componentInfo("materialQty") = 1
|
||
End If
|
||
|
||
componentInfo("remarks") = ""
|
||
|
||
Set ExtractComponentInfo = componentInfo
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
If Not g_Logger Is Nothing Then
|
||
g_Logger.Record rowNum, "M08.ExtractComponentInfo", "SystemError", _
|
||
"提取部件信息失败: " & Err.Description, componentType
|
||
End If
|
||
Set ExtractComponentInfo = Nothing
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 提取子部件信息（接头+弹性元件）
|
||
'
|
||
' 输入:
|
||
' wsComponent - "部件"工作表
|
||
' rowNum - 匹配到的行号
|
||
' headerMap - 表头映射
|
||
'
|
||
' 输出:
|
||
' Collection - 子部件集合
|
||
' 包含2个元素: 接头物料、弹性元件物料
|
||
'
|
||
' 注意:
|
||
' - "部件"工作表中，子件信息存储在特定列中
|
||
' - 需要根据实际的BOM库结构调整列名
|
||
' - 默认查找"接头_物料名称"、"接头_物料编码"、"接头_物料数量"等列
|
||
' ------------------------------------------------------------------------------
|
||
Private Function ExtractSubComponents( _
|
||
ByVal wsComponent As Worksheet, _
|
||
ByVal rowNum As Long, _
|
||
ByVal headerMap As Object _
|
||
) As Collection
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim subComponents As Collection
|
||
Set subComponents = New Collection
|
||
|
||
' 提取接头信息
|
||
Dim jointInfo As Object
|
||
Set jointInfo = ExtractSingleSubComponent(wsComponent, rowNum, headerMap, "接头")
|
||
|
||
If Not jointInfo Is Nothing Then
|
||
subComponents.Add jointInfo
|
||
End If
|
||
|
||
' 提取弹性元件信息
|
||
Dim elementInfo As Object
|
||
Set elementInfo = ExtractSingleSubComponent(wsComponent, rowNum, headerMap, "弹性元件")
|
||
|
||
If Not elementInfo Is Nothing Then
|
||
subComponents.Add elementInfo
|
||
End If
|
||
|
||
Set ExtractSubComponents = subComponents
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
If Not g_Logger Is Nothing Then
|
||
g_Logger.Record rowNum, "M08.ExtractSubComponents", "SystemError", _
|
||
"提取子件信息失败: " & Err.Description, ""
|
||
End If
|
||
Set ExtractSubComponents = New Collection
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 提取单个子部件信息
|
||
'
|
||
' 输入:
|
||
' wsComponent - "部件"工作表
|
||
' rowNum - 匹配到的行号
|
||
' headerMap - 表头映射
|
||
' subComponentType - 子件类型（"接头" 或 "弹性元件"）
|
||
'
|
||
' 输出:
|
||
' Object (Scripting.Dictionary) - 子件物料信息
|
||
'
|
||
' 逻辑:
|
||
' - 通过列名查找子部件信息（不依赖列位置）
|
||
' - 接头: 查找"接头名称"、"接头编码"、"接头数量"
|
||
' - 弹性元件: 查找"弹性元件名称"、"弹性元件编码"、"弹性元件数量"
|
||
' ------------------------------------------------------------------------------
|
||
Private Function ExtractSingleSubComponent( _
|
||
ByVal wsComponent As Worksheet, _
|
||
ByVal rowNum As Long, _
|
||
ByVal headerMap As Object, _
|
||
ByVal subComponentType As String _
|
||
) As Object
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim subInfo As Object
|
||
Set subInfo = CreateObject("Scripting.Dictionary")
|
||
subInfo("materialType") = subComponentType
|
||
|
||
' 根据子件类型确定列名
|
||
Dim nameKey As String, codeKey As String, qtyKey As String
|
||
|
||
If subComponentType = "接头" Then
|
||
nameKey = LCase(BOMLIB_COL_JOINT_NAME)
|
||
codeKey = LCase(BOMLIB_COL_JOINT_CODE)
|
||
qtyKey = LCase(BOMLIB_COL_JOINT_QTY)
|
||
ElseIf subComponentType = "弹性元件" Then
|
||
nameKey = LCase(BOMLIB_COL_ELEMENT_NAME)
|
||
codeKey = LCase(BOMLIB_COL_ELEMENT_CODE)
|
||
qtyKey = LCase(BOMLIB_COL_ELEMENT_QTY)
|
||
Else
|
||
' 未知类型，返回空信息
|
||
subInfo("materialName") = ""
|
||
subInfo("materialCode") = ""
|
||
subInfo("materialQty") = 0
|
||
subInfo("remarks") = "未知子件类型: " & subComponentType
|
||
Set ExtractSingleSubComponent = subInfo
|
||
Exit Function
|
||
End If
|
||
|
||
' 提取物料名称
|
||
If headerMap.Exists(nameKey) Then
|
||
Dim nameCol As Long
|
||
nameCol = headerMap(nameKey)
|
||
subInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, nameCol).Value))
|
||
Else
|
||
subInfo("materialName") = ""
|
||
End If
|
||
|
||
' 提取物料编码
|
||
If headerMap.Exists(codeKey) Then
|
||
Dim codeCol As Long
|
||
codeCol = headerMap(codeKey)
|
||
subInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, codeCol).Value))
|
||
Else
|
||
subInfo("materialCode") = ""
|
||
End If
|
||
|
||
' 提取物料数量
|
||
If headerMap.Exists(qtyKey) Then
|
||
Dim qtyCol As Long
|
||
qtyCol = headerMap(qtyKey)
|
||
Dim qtyValue As Variant
|
||
qtyValue = wsComponent.Cells(rowNum, qtyCol).Value
|
||
If IsNumeric(qtyValue) Then
|
||
subInfo("materialQty") = CLng(qtyValue)
|
||
Else
|
||
subInfo("materialQty") = 1
|
||
End If
|
||
Else
|
||
subInfo("materialQty") = 1
|
||
End If
|
||
|
||
subInfo("remarks") = "部件无库存，使用子件"
|
||
|
||
Set ExtractSingleSubComponent = subInfo
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
If Not g_Logger Is Nothing Then
|
||
g_Logger.Record rowNum, "M08.ExtractSingleSubComponent", "SystemError", _
|
||
"提取子件[" & subComponentType & "]失败: " & Err.Description, ""
|
||
End If
|
||
Set ExtractSingleSubComponent = Nothing
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 验证部件组合是否有效
|
||
'
|
||
' 输入:
|
||
' materials - 物料集合（包含所有类型的物料）
|
||
'
|
||
' 输出:
|
||
' Object (Scripting.Dictionary) - 验证结果
|
||
' 键值对: "valid"->Boolean, "message"->String
|
||
'
|
||
' 验证规则:
|
||
' - 正确组合1: 1个部件
|
||
' - 正确组合2: 1个接头 + 1个弹性元件
|
||
' - 异常: 其他组合
|
||
'
|
||
' 示例:
|
||
' Set validation = ValidateComponentCombination(materials)
|
||
' ' If Not validation("valid") Then
|
||
' ' ' 记录验证错误
|
||
' ' End If
|
||
' ------------------------------------------------------------------------------
|
||
Public Function ValidateComponentCombination(ByVal materials As Collection) As Object
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim result As Object
|
||
Set result = CreateObject("Scripting.Dictionary")
|
||
|
||
If materials Is Nothing Or materials.count = 0 Then
|
||
result("valid") = False
|
||
result("message") = "物料列表为空"
|
||
Set ValidateComponentCombination = result
|
||
Exit Function
|
||
End If
|
||
|
||
' 统计各类型物料数量
|
||
Dim componentCount As Long
|
||
Dim jointCount As Long
|
||
Dim elementCount As Long
|
||
Dim otherCount As Long
|
||
|
||
componentCount = 0
|
||
jointCount = 0
|
||
elementCount = 0
|
||
otherCount = 0
|
||
|
||
Dim mat As Variant
|
||
For Each mat In materials
|
||
Dim matType As String
|
||
matType = CStr(mat("materialType"))
|
||
|
||
Select Case matType
|
||
Case "部件"
|
||
componentCount = componentCount + 1
|
||
Case "接头"
|
||
jointCount = jointCount + 1
|
||
Case "弹性元件"
|
||
elementCount = elementCount + 1
|
||
Case Else
|
||
otherCount = otherCount + 1
|
||
End Select
|
||
Next mat
|
||
|
||
' 验证组合规则
|
||
' 规则1: 只有1个部件，没有接头和弹性元件
|
||
If componentCount = 1 And jointCount = 0 And elementCount = 0 Then
|
||
result("valid") = True
|
||
result("message") = "验证通过：1个部件"
|
||
Set ValidateComponentCombination = result
|
||
Exit Function
|
||
End If
|
||
|
||
' 规则2: 没有部件，恰好1个接头和1个弹性元件
|
||
If componentCount = 0 And jointCount = 1 And elementCount = 1 Then
|
||
result("valid") = True
|
||
result("message") = "验证通过：1个接头+1个弹性元件"
|
||
Set ValidateComponentCombination = result
|
||
Exit Function
|
||
End If
|
||
|
||
' 其他情况都是异常
|
||
Dim errorMsg As String
|
||
errorMsg = "部件组合异常: "
|
||
|
||
If componentCount > 1 Then
|
||
errorMsg = errorMsg & "部件数量为" & componentCount & "（应为1）"
|
||
ElseIf componentCount = 1 And (jointCount > 0 Or elementCount > 0) Then
|
||
errorMsg = errorMsg & "同时存在部件和子件（不应共存）"
|
||
ElseIf jointCount <> elementCount Then
|
||
errorMsg = errorMsg & "接头数量(" & jointCount & ")≠弹性元件数量(" & elementCount & ")"
|
||
ElseIf jointCount = 0 And elementCount = 0 Then
|
||
errorMsg = errorMsg & "缺少部件和子件"
|
||
Else
|
||
errorMsg = errorMsg & "未知异常组合"
|
||
End If
|
||
|
||
result("valid") = False
|
||
result("message") = errorMsg
|
||
|
||
Set ValidateComponentCombination = result
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
result("valid") = False
|
||
result("message") = "验证过程发生错误: " & Err.Description
|
||
Set ValidateComponentCombination = result
|
||
End Function |