Files
AutoBOM/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas
Misaka_Company c696057cd4
All checks were successful
NTFY Notification / notify (push) Successful in 5s
feat: implement inventory comparison worksheet for component materials
Add new "库存比对" worksheet that displays component inventory status
alongside material requirements for production planning.

Changes:
- M04_Config: Add INVENTORY_COMPARISON_SHEET_NAME constant
- M08_ComponentProcessor: Enhance component processing to return both
  component and sub-components when inventory insufficient; add
  GetComponentInventoryInfo() read-only function for inventory lookup
- M09_BOMExtractor: Add WriteInventoryComparisonResults() function
  to generate inventory comparison worksheet with 7 columns showing
  material code, name, required quantity, stock quantity, and status

Output format:
- Columns: 序号, 生产订单号, 物料编码, 物料名称, 所需数量, 库存数量, 库存充足
- Color coding: Green (sufficient) / Red (insufficient)
- Sequence numbering: 10+0, 10+1 per order

Backward compatibility: Existing BOM提取结果 and BIP上传 worksheets
remain unchanged.

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

769 lines
26 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.
' ==============================================================================
' 模块: M08_ComponentProcessor
' 职责: 处理"部件"物料的特殊逻辑
'
' 部件物料特性:
' - 每条"部件"记录包含三个物料的数据:
' 1. 部件物料本身
' 2. 接头物料子件1
' 3. 弹性元件物料子件2
'
' 选择策略:
' - 优先选择"部件"物料
' - 当"部件"物料库存不足时,选择"接头"+"弹性元件"
' - 库存检查接口预留当前默认返回True库存充足
'
' 验证规则:
' - 正常组合1: 1个部件
' - 正常组合2: 1个接头 + 1个弹性元件
' - 异常: 其他组合(如只有接头、只有弹性元件、同时有部件和接头等)
' ==============================================================================
Option Explicit
' 模块级变量 - 错误记录器
Private g_Logger As clsErrorLogger
' 模块级变量 - 库存追踪
Private g_InventoryDict As Object ' 部件编码 -> 现存量
Private g_AccumulatedDemandDict As Object ' 部件编码 -> 累计需求量
' ------------------------------------------------------------------------------
' 初始化部件处理器
' ------------------------------------------------------------------------------
Public Sub InitComponentProcessor(logger As clsErrorLogger)
Set g_Logger = logger
End Sub
' ------------------------------------------------------------------------------
' 初始化部件处理器(带库存校验)
'
' 输入:
' logger - 错误记录器
' inventoryWb - 包含现存量工作表的工作簿通常是ThisWorkbook
' ------------------------------------------------------------------------------
Public Sub InitComponentProcessorWithInventory( _
logger As clsErrorLogger, _
inventoryWb As Workbook _
)
Set g_Logger = logger
Call LoadInventoryData(inventoryWb)
Set g_AccumulatedDemandDict = CreateObject("Scripting.Dictionary")
End Sub
' ------------------------------------------------------------------------------
' 加载库存数据
'
' 输入:
' inventoryWb - 包含现存量工作表的工作簿
'
' 逻辑:
' 1. 查找[现存量]工作表
' 2. 如果未找到记录警告并使用空字典所有库存视为0
' 3. 从第4行开始读取数据表头在第3行
' 4. B列 = 物料编码J列 = 库存数量
' 5. 存储到 g_InventoryDict 中
' ------------------------------------------------------------------------------
Private Sub LoadInventoryData(ByVal inventoryWb As Workbook)
On Error GoTo ErrorHandler
Set g_InventoryDict = CreateObject("Scripting.Dictionary")
' 检查现存量工作表是否存在
Dim wsInventory As Worksheet
On Error Resume Next
Set wsInventory = inventoryWb.Sheets(INVENTORY_SHEET_NAME)
On Error GoTo ErrorHandler
If wsInventory Is Nothing Then
' 未找到现存量工作表记录警告并使用空字典所有库存视为0
If Not g_Logger Is Nothing Then
g_Logger.RecordWarning "", "M08.LoadInventoryData", "InventorySheetMissing", _
"未找到[" & INVENTORY_SHEET_NAME & "]工作表所有部件库存将视为0", ""
End If
Exit Sub
End If
' 查找最后一行
Dim lastRow As Long
lastRow = wsInventory.Cells(wsInventory.Rows.Count, 2).End(xlUp).Row ' B列
If lastRow < INVENTORY_HEADER_ROW + 1 Then
Exit Sub ' 没有数据
End If
' 从第4行开始读取数据表头在第3行
Dim i As Long
For i = INVENTORY_HEADER_ROW + 1 To lastRow
Dim materialCode As String
Dim stockQty As Variant
materialCode = Trim(CStr(wsInventory.Cells(i, INVENTORY_COL_CODE).Value))
stockQty = wsInventory.Cells(i, INVENTORY_COL_QTY).Value
If Len(materialCode) > 0 And IsNumeric(stockQty) Then
g_InventoryDict(materialCode) = CLng(stockQty)
End If
Next i
Exit Sub
ErrorHandler:
If Not g_Logger Is Nothing Then
g_Logger.RecordWarning "", "M08.LoadInventoryData", "LoadError", _
"加载库存数据失败: " & Err.Description, ""
End If
End Sub
' ------------------------------------------------------------------------------
' 主入口: 处理"部件"记录,返回物料集合
'
' 输入:
' wsComponent - "部件"工作表
' params - 从产品型号中提取的参数字典
' logger - 错误记录器
' matchedRowNum - 匹配到的行号(由调用者传入,避免重复匹配)
'
' 输出:
' Collection - 物料集合
' 每个元素是一个字典,包含: materialName, materialCode, materialQty, materialType, remarks
'
' 逻辑流程:
' 1. 使用传入的matchedRowNum定位匹配记录
' 2. 检查"部件"物料库存
' 3. 如果有库存,返回部件物料
' 4. 如果无库存,提取子件(接头+弹性元件)
'
' 示例:
' Set materials = ProcessComponentRecord(wsComponent, params, logger, 5)
' ' materials(1) - 部件物料 或 接头物料
' ' materials(2) - 弹性元件物料(如果选择子件)
' ------------------------------------------------------------------------------
Public Function ProcessComponentRecord( _
ByVal wsComponent As Worksheet, _
ByVal params As Object, _
ByVal logger As clsErrorLogger, _
ByVal matchedRowNum As Long, _
ByVal orderQty As Long, _
ByVal productionOrderNo As String _
) As Collection
On Error GoTo ErrorHandler
Dim materials As Collection
Set materials = New Collection
' 步骤1: 验证传入的行号
If matchedRowNum <= 0 Then
' 无效行号,返回错误物料
Dim errorMaterial As Object
Set errorMaterial = CreateObject("Scripting.Dictionary")
errorMaterial("materialType") = "部件"
errorMaterial("materialName") = ""
errorMaterial("materialCode") = ""
errorMaterial("materialQty") = 0
errorMaterial("remarks") = "无效的匹配行号"
materials.Add errorMaterial
Set ProcessComponentRecord = materials
Exit Function
End If
' 步骤2: 使用传入的行号
' 步骤3: 构建表头映射
Dim headerMap As Object
Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(wsComponent)
' 步骤4: 检查部件库存
Dim componentInfo As Object
If CheckComponentInventory(wsComponent, matchedRowNum, headerMap, orderQty, productionOrderNo) Then
' 库存充足,返回部件物料
Set componentInfo = ExtractComponentInfo(wsComponent, matchedRowNum, headerMap, "部件")
componentInfo("remarks") = ""
componentInfo("isStockSufficient") = True
If Not componentInfo Is Nothing Then
materials.Add componentInfo
End If
Else
' 【关键修复】库存不足时,同时返回部件(标记)和子件
' 步骤1: 返回部件信息(用于库存比对表)
Set componentInfo = ExtractComponentInfo(wsComponent, matchedRowNum, headerMap, "部件")
componentInfo("remarks") = "部件无库存,使用子件"
componentInfo("isStockSufficient") = False
If Not componentInfo Is Nothing Then
materials.Add componentInfo
End If
' 步骤2: 返回子件信息用于BOM提取结果和BIP上传
Dim subComponents As Collection
Set subComponents = ExtractSubComponents(wsComponent, matchedRowNum, 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 productionOrderNo, "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 - 表头映射
' orderQty - 订单数量
'
' 输出:
' Boolean - True表示库存充足False表示库存不足
'
' 逻辑:
' 1. 提取部件编码
' 2. 获取BOM需求量部件工作表中的数量列
' 3. 检查库存数据是否存在
' 4. 计算累计需求量 = 订单数量 × BOM需求量 + 之前累计需求
' 5. 比较库存和需求,更新累计需求量
'
' 示例:
' 订单1、订单3、订单6都用部件A每个订单数量=2BOM需求量=1现存量=5
' - 订单1累计需求 = 2×1 + 0 = 25 >= 2 ✓ true使用部件
' - 订单3累计需求 = 2×1 + 2 = 45 >= 4 ✓ true使用部件
' - 订单6累计需求 = 2×1 + 4 = 65 < 6 ✗ false使用子件
' ------------------------------------------------------------------------------
Private Function CheckComponentInventory( _
ByVal wsComponent As Worksheet, _
ByVal rowNum As Long, _
ByVal headerMap As Object, _
ByVal orderQty As Long, _
ByVal productionOrderNo As String _
) As Boolean
On Error GoTo ErrorHandler
' 步骤1: 提取部件编码
Dim codeCol As Long
Dim codeKey As String
codeKey = LCase(BOMLIB_COL_CODE)
If Not headerMap.Exists(codeKey) Then
' 没有编码列默认返回True库存充足
CheckComponentInventory = True
Exit Function
End If
codeCol = headerMap(codeKey)
Dim componentCode As String
componentCode = Trim(CStr(wsComponent.Cells(rowNum, codeCol).Value))
If Len(componentCode) = 0 Then
' 没有编码默认返回True
CheckComponentInventory = True
Exit Function
End If
' 步骤2: 获取BOM需求量部件工作表中的数量列
Dim bomQty As Long
bomQty = 1 ' 默认为1
Dim qtyKey As String
qtyKey = LCase(BOMLIB_COL_QTY)
If headerMap.Exists(qtyKey) Then
Dim qtyCol As Long
Dim qtyValue As Variant
qtyCol = headerMap(qtyKey)
qtyValue = wsComponent.Cells(rowNum, qtyCol).Value
If IsNumeric(qtyValue) Then
bomQty = CLng(qtyValue)
End If
End If
' 步骤3: 检查库存数据是否存在
If g_InventoryDict Is Nothing Or Not g_InventoryDict.Exists(componentCode) Then
' 未找到库存数据记录警告并返回False库存不足
If Not g_Logger Is Nothing Then
g_Logger.RecordWarning productionOrderNo, "M08.CheckComponentInventory", "InventoryNotFound", _
"部件[" & componentCode & "]未找到库存数据,视为库存不足", ""
End If
CheckComponentInventory = False
Exit Function
End If
' 步骤4: 计算累计需求量
Dim currentDemand As Long
currentDemand = orderQty * bomQty
Dim accumulatedDemand As Long
If g_AccumulatedDemandDict.Exists(componentCode) Then
accumulatedDemand = g_AccumulatedDemandDict(componentCode)
End If
Dim totalDemand As Long
totalDemand = accumulatedDemand + currentDemand
' 步骤5: 比较库存和需求
Dim stockQty As Long
stockQty = g_InventoryDict(componentCode)
If stockQty >= totalDemand Then
' 库存充足,更新累计需求量
g_AccumulatedDemandDict(componentCode) = totalDemand
CheckComponentInventory = True
Else
' 库存不足,记录警告(不是错误)
If Not g_Logger Is Nothing Then
g_Logger.RecordWarning productionOrderNo, "M08.CheckComponentInventory", "InsufficientInventory", _
"部件[" & componentCode & "]库存不足。库存=" & stockQty & ", 累计需求=" & totalDemand, ""
End If
CheckComponentInventory = False
End If
Exit Function
ErrorHandler:
If Not g_Logger Is Nothing Then
g_Logger.Record productionOrderNo, "M08.CheckComponentInventory", "SystemError", _
"库存检查失败: " & Err.Description, ""
End If
' 出错时返回False库存不足
CheckComponentInventory = False
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") = ""
componentInfo("isStockSufficient") = True ' 默认值,会在 ProcessComponentRecord 中被覆盖
Set ExtractComponentInfo = componentInfo
Exit Function
ErrorHandler:
If Not g_Logger Is Nothing Then
g_Logger.Record "", "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 "", "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 "", "M08.ExtractSingleSubComponent", "SystemError", _
"提取子件[" & subComponentType & "]失败: " & Err.Description, ""
End If
Set ExtractSingleSubComponent = Nothing
End Function
' ------------------------------------------------------------------------------
' 获取部件库存信息(用于库存比对工作表)
'
' 输入:
' componentCode - 部件编码
' bomQty - BOM需求量单个产品
' orderQty - 订单数量
'
' 输出:
' Object - 库存信息字典
' .stockQty - 库存数量
' .requiredQty - 所需数量 (orderQty × bomQty)
' .accumulatedDemand - 累计需求量
' .totalDemand - 总需求量 (累计需求 + 当前需求)
' .isSufficient - 库存是否充足 (True/False)
'
' 注意:
' - 此函数是只读的,不会修改 g_AccumulatedDemandDict
' - 库存充足性判断基于累计需求量,但仅返回结果,不更新状态
' ------------------------------------------------------------------------------
Public Function GetComponentInventoryInfo( _
ByVal componentCode As String, _
ByVal bomQty As Long, _
ByVal orderQty As Long _
) As Object
On Error GoTo ErrorHandler
Dim invInfo As Object
Set invInfo = CreateObject("Scripting.Dictionary")
' 步骤1: 获取库存数量
Dim stockQty As Long
stockQty = 0 ' 默认值为0
If Not g_InventoryDict Is Nothing And g_InventoryDict.Exists(componentCode) Then
stockQty = g_InventoryDict(componentCode)
End If
' 步骤2: 计算需求量
Dim requiredQty As Long
requiredQty = orderQty * bomQty
Dim accumulatedDemand As Long
accumulatedDemand = 0
If Not g_AccumulatedDemandDict Is Nothing Then
If g_AccumulatedDemandDict.Exists(componentCode) Then
accumulatedDemand = g_AccumulatedDemandDict(componentCode)
End If
End If
Dim totalDemand As Long
totalDemand = accumulatedDemand + requiredQty
' 步骤3: 判断库存是否充足
Dim isSufficient As Boolean
isSufficient = (stockQty >= totalDemand)
' 步骤4: 返回库存信息
invInfo("stockQty") = stockQty
invInfo("requiredQty") = requiredQty
invInfo("accumulatedDemand") = accumulatedDemand
invInfo("totalDemand") = totalDemand
invInfo("isSufficient") = isSufficient
Set GetComponentInventoryInfo = invInfo
Exit Function
ErrorHandler:
' 出错时返回默认值(库存不足)
Dim errorInfo As Object
Set errorInfo = CreateObject("Scripting.Dictionary")
errorInfo("stockQty") = 0
errorInfo("requiredQty") = orderQty * bomQty
errorInfo("accumulatedDemand") = 0
errorInfo("totalDemand") = orderQty * bomQty
errorInfo("isSufficient") = False
Set GetComponentInventoryInfo = errorInfo
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