diff --git a/VBA/ClassModules/clsBOMManager.cls b/VBA/ClassModules/clsBOMManager.cls
index bdbda7a..8a0a6aa 100644
--- a/VBA/ClassModules/clsBOMManager.cls
+++ b/VBA/ClassModules/clsBOMManager.cls
@@ -692,6 +692,7 @@ End Function
' Collection中包含两个元素:
' (1) "Materials" - Collection对象,包含所有匹配的 clsMaterialItem 对象
' (2) "IsComplete" - Boolean值,指示物料是否完整
+' (3) "MissingCategories" - Collection对象, 包含所有缺失的类别名称字符串
'
' 完整性判断规则:
' - 对于每个需要领料的类别(顶层类别或其需要领取的子类别)
@@ -709,6 +710,7 @@ End Function
Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim result As New collection
Dim allMaterials As New collection
+ Dim allMissingCats As New collection ' 用于存储所有缺失的类别
Dim isComplete As Boolean
' 解析型号并提取条件
@@ -718,6 +720,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
isComplete = False
result.Add allMaterials, "Materials"
result.Add isComplete, "IsComplete"
+ result.Add allMissingCats, "MissingCategories"
Set GetValidMaterialsByModel = result
Exit Function
End If
@@ -726,23 +729,11 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim conditions As Object
Set conditions = extractor.ExtractConditions(parser)
- ' 调试输出
- Debug.Print "【GetValidMaterialsByModel】"
- Debug.Print "型号: " & modelStr
- Debug.Print "提取的条件:"
- Dim key As Variant
- For Each key In conditions.Keys
- Debug.Print " " & key & " = " & conditions(key)
- Next key
- Debug.Print ""
-
' 条件匹配器
Dim matcher As New clsConditionMatcher
' 遍历所有根类别,检查完整性
isComplete = True
- Dim categoryCheckResults As Object
- Set categoryCheckResults = CreateObject("Scripting.Dictionary")
Dim rootCat As clsCategory
Dim i As Long
@@ -753,7 +744,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim catResult As Object
Set catResult = CheckCategoryCompleteness(rootCat, matcher, conditions)
- ' 合并物料
+ ' 1. 合并匹配到的物料
Dim mat As clsMaterialItem
Dim matCollection As collection
Set matCollection = catResult("Materials")
@@ -761,29 +752,25 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
allMaterials.Add mat
Next mat
- ' 检查完整性
+ ' 2. 合并缺失的类别 (新增)
+ Dim missingCollection As collection
+ Set missingCollection = catResult("Missing")
+ Dim missingCatName As Variant
+ For Each missingCatName In missingCollection
+ allMissingCats.Add missingCatName
+ Next missingCatName
+
+ ' 3. 检查完整性状态
If Not catResult("IsComplete") Then
isComplete = False
- Debug.Print "【不完整】类别 """ & rootCat.categoryName & """ 物料不完整"
End If
-
- ' 保存类别检查结果(用于调试)
- categoryCheckResults(rootCat.categoryName) = catResult("IsComplete")
Next i
- ' 调试输出总结
- Debug.Print ""
- Debug.Print "【完整性检查结果】"
- Debug.Print "总物料数: " & allMaterials.count
- Debug.Print "是否完整: " & IIf(isComplete, "是", "否")
- For Each key In categoryCheckResults.Keys
- Debug.Print " " & key & ": " & IIf(categoryCheckResults(key), "完整", "不完整")
- Next key
- Debug.Print String(60, "=")
-
' 返回结果
result.Add allMaterials, "Materials"
result.Add isComplete, "IsComplete"
+ result.Add allMissingCats, "MissingCategories" ' 新增返回项
+
Set GetValidMaterialsByModel = result
End Function
@@ -797,6 +784,7 @@ End Function
' 返回: Dictionary对象
' "Materials" - Collection,包含该类别匹配的物料
' "IsComplete" - Boolean,该类别是否完整
+' "Missing" - Collection, 缺失的类别名称列表
'
' 完整性判断逻辑:
' 1. 如果类别没有子类别(叶子类别):
@@ -817,6 +805,7 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
Set result = CreateObject("Scripting.Dictionary")
Dim materials As New collection
+ Dim missingCats As New collection ' 本层级及子层级缺失的类别
Dim isComplete As Boolean
' 首先在当前类别查找匹配的物料
@@ -837,36 +826,31 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
If Not cat.HasSubCategories Then
' ========================================
' 情况1: 叶子类别(无子类别)
- ' 必须有且仅有1个物料
' ========================================
If matchCount = 1 Then
isComplete = True
- Debug.Print "【完整】叶子类别 """ & cat.categoryName & """ 有1个匹配物料"
Else
isComplete = False
+ ' 如果是叶子节点且没有匹配到物料，记录该类别为缺失
If matchCount = 0 Then
- Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 无匹配物料"
- Else
- Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为1个)"
+ missingCats.Add cat.categoryName
End If
+ ' 注: matchCount > 1 属于配置错误(重复匹配)，算不完整，但通常不算"Missing"
End If
Else
' ========================================
' 情况2: 有子类别
- ' 先检查父类别,如果父类别满足则使用父类别
- ' 否则降级到子类别,每个子类别都必须满足
' ========================================
If matchCount = 1 Then
- ' 父类别有且仅有1个物料,使用父类别
+ ' 父类别有且仅有1个物料, 使用父类别 -> 完整
isComplete = True
- Debug.Print "【完整】父类别 """ & cat.categoryName & """ 有1个匹配物料,使用父类别"
+ ' 不需要检查子类别了，missingCats 保持为空
ElseIf matchCount = 0 Then
- ' 父类别无匹配物料,降级到子类别
- Debug.Print "【降级】父类别 """ & cat.categoryName & """ 无匹配物料,检查子类别..."
+ ' 父类别无匹配物料, 必须降级检查所有子类别
- ' 清空物料集合,准备收集子类别物料
+ ' 清空当前物料集合(确保没东西), 准备收集子类别结果
Set materials = New collection
- isComplete = True ' 假设完整,如果任一子类别不完整则设为False
+ isComplete = True ' 先假设完整, 若任一子类别不完整则置错
Dim subCat As clsCategory
Dim j As Long
@@ -877,7 +861,7 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
Dim subResult As Object
Set subResult = CheckCategoryCompleteness(subCat, matcher, conditions)
- ' 合并子类别物料
+ ' a) 合并子类别物料
Dim subMaterials As collection
Set subMaterials = subResult("Materials")
Dim k As Long
@@ -885,26 +869,28 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
materials.Add subMaterials(k)
Next k
- ' 检查子类别是否完整
+ ' b) 合并子类别缺失列表 (关键步骤)
+ Dim subMissing As collection
+ Set subMissing = subResult("Missing")
+ Dim item As Variant
+ For Each item In subMissing
+ missingCats.Add item
+ Next item
+
+ ' c) 更新完整性状态
If Not subResult("IsComplete") Then
isComplete = False
End If
Next j
-
- If isComplete Then
- Debug.Print "【完整】类别 """ & cat.categoryName & """ 所有子类别都完整"
- Else
- Debug.Print "【不完整】类别 """ & cat.categoryName & """ 存在不完整的子类别"
- End If
Else
- ' 父类别有多个匹配物料,不完整
+ ' 父类别有 >1 个匹配, 视为不完整(冲突)
isComplete = False
- Debug.Print "【不完整】父类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为0或1个)"
End If
End If
- ' 返回结果
+ ' 封装返回结果
Set result("Materials") = materials
result("IsComplete") = isComplete
+ Set result("Missing") = missingCats
Set CheckCategoryCompleteness = result
-End Function
\ No newline at end of file
+End Function
diff --git a/VBA/Modules/modModelParserExamples.bas b/VBA/Modules/modModelParserExamples.bas
index d27ec8f..bb360e5 100644
--- a/VBA/Modules/modModelParserExamples.bas
+++ b/VBA/Modules/modModelParserExamples.bas
@@ -502,7 +502,7 @@ Sub Example6_CompareAutoFallback()
End Sub
' ========================================
-' 示例7: 测试GetValidMaterialsByModel方法
+' 示例7: 测试GetValidMaterialsByModel方法 (使用内置的缺失列表)
' ========================================
Sub Example7_TestGetValidMaterialsByModel()
Dim bomMgr As New clsBOMManager
@@ -533,13 +533,11 @@ Sub Example7_TestGetValidMaterialsByModel()
wsTest.Cells(row, 1).Font.Size = 14
row = row + 2
- ' 测试多个型号
+ ' 定义测试型号
Dim testModels() As Variant
testModels = Array( _
Array("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3", "完整型号测试1"), _
- Array("YTHN-100.A0.532.M203.M02.Y3|BP-095.2312.M02.PA3", "完整型号测试2"), _
- Array("YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", "完整型号测试3"), _
- Array("YTHN-100.A0.532.M203.M17.Y3", "可能不完整的型号") _
+ Array("YTHN-100.A0.532.M203.M17.Y3", "缺失子类别测试") _
)
Dim i As Long
@@ -549,18 +547,22 @@ Sub Example7_TestGetValidMaterialsByModel()
modelStr = testModels(i)(0)
testName = testModels(i)(1)
- ' 调用GetValidMaterialsByModel
+ ' 1. 调用方法获取结果
Dim result As collection
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
Dim materials As collection
+ Dim missingCats As collection
Dim isComplete As Boolean
+
Set materials = result("Materials")
+ Set missingCats = result("MissingCategories") ' 直接获取缺失列表
isComplete = result("IsComplete")
- ' 写入测试名称和型号
+ ' 2. 写入头部信息
wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName
wsTest.Cells(row, 1).Font.Bold = True
+ wsTest.Cells(row, 1).Interior.Color = RGB(240, 240, 240)
row = row + 1
wsTest.Cells(row, 1).value = "型号:"
@@ -568,41 +570,58 @@ Sub Example7_TestGetValidMaterialsByModel()
row = row + 1
wsTest.Cells(row, 1).value = "完整性:"
- wsTest.Cells(row, 2).value = IIf(isComplete, "?? 完整", "?? 不完整")
+ wsTest.Cells(row, 2).value = IIf(isComplete, "✓ 完整", "✕ 不完整")
If isComplete Then
- wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0) ' 绿色
+ wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
Else
- wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0) ' 红色
+ wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
End If
wsTest.Cells(row, 2).Font.Bold = True
row = row + 1
-
- wsTest.Cells(row, 1).value = "物料数量:"
- wsTest.Cells(row, 2).value = materials.count
+
+ ' 3. 打印匹配到的物料
+ wsTest.Cells(row, 1).value = "【已匹配物料】"
+ wsTest.Cells(row, 1).Font.Bold = True
row = row + 1
-
- ' 写入物料明细表头
+
wsTest.Cells(row, 1).value = "类别"
wsTest.Cells(row, 2).value = "代号"
wsTest.Cells(row, 3).value = "名称"
wsTest.Cells(row, 4).value = "数量"
- wsTest.Cells(row, 5).value = "选择条件"
- wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Font.Bold = True
- wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Interior.Color = RGB(200, 200, 200)
+ wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Font.Bold = True
+ wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Interior.Color = RGB(220, 220, 220)
row = row + 1
-
- ' 写入每个物料
+
Dim mat As clsMaterialItem
- Dim j As Long
- For j = 1 To materials.count
- Set mat = materials(j)
- wsTest.Cells(row, 1).value = mat.Category
- wsTest.Cells(row, 2).value = mat.code
- wsTest.Cells(row, 3).value = mat.Name
- wsTest.Cells(row, 4).value = mat.Quantity
- wsTest.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition)
+ If materials.count > 0 Then
+ For Each mat In materials
+ wsTest.Cells(row, 1).value = mat.Category
+ wsTest.Cells(row, 2).value = mat.code
+ wsTest.Cells(row, 3).value = mat.Name
+ wsTest.Cells(row, 4).value = mat.Quantity
+ row = row + 1
+ Next mat
+ Else
+ wsTest.Cells(row, 1).value = "(无)"
row = row + 1
- Next j
+ End If
+
+ ' 4. 打印缺失的类别 (新增核心功能)
+ If missingCats.count > 0 Then
+ row = row + 1
+ wsTest.Cells(row, 1).value = "【缺失类别】"
+ wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
+ wsTest.Cells(row, 1).Font.Bold = True
+ row = row + 1
+
+ Dim catName As Variant
+ For Each catName In missingCats
+ wsTest.Cells(row, 1).value = "❌ " & catName
+ wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
+ wsTest.Cells(row, 2).value = "未找到匹配物料"
+ row = row + 1
+ Next catName
+ End If
' 添加分隔行
row = row + 1
@@ -610,45 +629,6 @@ Sub Example7_TestGetValidMaterialsByModel()
row = row + 2
Next i
- ' 添加统计汇总
- wsTest.Cells(row, 1).value = "测试汇总"
- wsTest.Cells(row, 1).Font.Bold = True
- wsTest.Cells(row, 1).Font.Size = 12
- row = row + 1
-
- Dim completeCount As Long
- Dim incompleteCount As Long
- completeCount = 0
- incompleteCount = 0
-
- For i = LBound(testModels) To UBound(testModels)
- modelStr = testModels(i)(0)
- Set result = bomMgr.GetValidMaterialsByModel(modelStr)
- If result("IsComplete") Then
- completeCount = completeCount + 1
- Else
- incompleteCount = incompleteCount + 1
- End If
- Next i
-
- wsTest.Cells(row, 1).value = "总测试数:"
- wsTest.Cells(row, 2).value = UBound(testModels) - LBound(testModels) + 1
- row = row + 1
-
- wsTest.Cells(row, 1).value = "完整:"
- wsTest.Cells(row, 2).value = completeCount
- wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
- row = row + 1
-
- wsTest.Cells(row, 1).value = "不完整:"
- wsTest.Cells(row, 2).value = incompleteCount
- wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
-
- ' 格式化
- wsTest.Columns("A:E").AutoFit
-
- MsgBox "物料完整性测试完成！" & vbCrLf & _
- "完整: " & completeCount & " 个" & vbCrLf & _
- "不完整: " & incompleteCount & " 个" & vbCrLf & vbCrLf & _
- "请查看工作表: 物料完整性测试", vbInformation
+ wsTest.Columns("A:D").AutoFit
+ MsgBox "测试完成！", vbInformation
End Sub
\ No newline at end of file
diff --git a/VBA/combined_output.md b/VBA/combined_output.md
new file mode 100644
index 0000000..f095227
--- /dev/null
+++ b/VBA/combined_output.md
@@ -0,0 +1,2876 @@
+# 目录
+
+- [ClassModules\clsBOMManager.cls](#classmodules-clsbommanager-cls)
+- [ClassModules\clsCategory.cls](#classmodules-clscategory-cls)
+- [ClassModules\clsConditionExtractor.cls](#classmodules-clsconditionextractor-cls)
+- [ClassModules\clsConditionMatcher.cls](#classmodules-clsconditionmatcher-cls)
+- [ClassModules\clsMaterialItem.cls](#classmodules-clsmaterialitem-cls)
+- [ClassModules\clsModelParser.cls](#classmodules-clsmodelparser-cls)
+- [Modules\modBOMProcessor.bas](#modules-modbomprocessor-bas)
+- [Modules\modModelParserExamples.bas](#modules-modmodelparserexamples-bas)
+- [Modules\modModelParserTest.bas](#modules-modmodelparsertest-bas)
+
+---
+
+## ClassModules\clsBOMManager.cls
+
+```
+' ========================================
+' 类模块: clsBOMManager
+' 用途: 管理整个BOM数据结构
+' 功能:
+' 1. 加载和组织BOM数据
+' 2. 建立类别层级关系
+' 3. 提供物料查询接口
+' 4. 支持领料逻辑处理
+' ========================================
+Option Explicit
+
+' ========================================
+' 私有成员变量
+' ========================================
+Private dictCategories As Object ' Dictionary对象: 类别名称 -> clsCategory对象
+ ' 作用: 快速查找任意类别
+Private dictAllMaterials As Object ' Dictionary对象: 物料代号 -> clsMaterialItem对象
+ ' 作用: 快速查找任意物料
+Private rootCategories As collection ' Collection: 存储所有顶层类别(无父类别的类别)
+ ' 作用: 遍历完整的类别树结构
+
+' ========================================
+' 类初始化
+' 说明: 创建BOMManager实例时自动调用
+' ========================================
+Private Sub Class_Initialize()
+ Set dictCategories = CreateObject("Scripting.Dictionary")
+ Set dictAllMaterials = CreateObject("Scripting.Dictionary")
+ Set rootCategories = New collection
+End Sub
+
+' ========================================
+' LoadData 方法
+' 功能: 从Excel工作表加载BOM数据并构建数据结构
+' 参数:
+' wsConfig - [领料配置]工作表对象,包含类别层级和需要领料的物料
+' wsPlatform - [平台配置清单]工作表对象,包含完整的物料信息(代号/名称/数量/条件)
+' 处理步骤:
+' 1. 从[平台配置清单]加载所有物料的基础信息到dictAllMaterials
+' 2. 从[领料配置]加载类别信息,筛选需要领料的物料
+' 3. 建立类别的父子关系,构建层级树
+' 注意:
+' - 只有出现在[领料配置]中的物料才会被添加到类别中
+' - 未在[领料配置]中的物料表示不需要领料
+' ========================================
+Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet)
+ Dim i As Long, lastRow As Long
+ Dim mat As clsMaterialItem
+ Dim cat As clsCategory
+
+ ' ========================================
+ ' 第一步: 从平台配置清单加载所有物料的基础信息
+ ' 说明:
+ ' - 读取C列(代号)、D列(名称)、E列(数量)、F列(选择条件)
+ ' - 从第4行开始读取(前3行是标题)
+ ' - 所有物料存入dictAllMaterials字典,以代号为键
+ ' 目的: 建立完整的物料信息库,供后续按代号查询
+ ' ========================================
+ lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "C").End(xlUp).row
+ For i = 4 To lastRow ' 从第4行开始(跳过标题)
+ Set mat = New clsMaterialItem
+ mat.code = Trim(wsPlatform.Cells(i, "C").value & "") ' 物料代号
+ mat.Name = Trim(wsPlatform.Cells(i, "D").value & "") ' 物料名称
+ On Error Resume Next
+ mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) ' 物料数量
+ On Error GoTo 0
+ mat.Condition = Trim(wsPlatform.Cells(i, "F").value & "") ' 选择条件
+
+ ' 只保存代号非空的物料
+ If mat.code <> "" Then
+ Set dictAllMaterials(mat.code) = mat
+ End If
+ Next i
+
+ ' ========================================
+ ' 第二步: 从领料配置加载类别信息并建立层级
+ ' 说明:
+ ' - 读取A列(代号)、C列(类别)、D列(上层类别)
+ ' - 从第2行开始读取(第1行是标题)
+ ' - 只有出现在此表中的物料才需要领料
+ ' 处理逻辑:
+ ' 1. 为每个类别创建clsCategory对象
+ ' 2. 从dictAllMaterials中查找对应的物料信息
+ ' 3. 将物料添加到对应的类别中
+ ' ========================================
+ lastRow = wsConfig.Cells(wsConfig.Rows.Count, "A").End(xlUp).row
+ For i = 2 To lastRow ' 从第2行开始
+ Dim code As String, catName As String, parentCatName As String
+ code = Trim(wsConfig.Cells(i, "A").value & "") ' 物料代号
+ catName = Trim(wsConfig.Cells(i, "C").value & "") ' 类别名称
+ parentCatName = Trim(wsConfig.Cells(i, "D").value & "") ' 上层类别名称
+
+ ' 跳过空行
+ If code = "" Then GoTo NextRow
+
+ ' 确保类别对象存在(如果类别不存在则创建)
+ If Not dictCategories.Exists(catName) Then
+ Set cat = New clsCategory
+ cat.categoryName = catName
+ cat.ParentCategoryName = parentCatName
+ Set dictCategories(catName) = cat
+ End If
+
+ ' 将物料添加到类别
+ ' 注意: 必须先在dictAllMaterials中查找到完整的物料信息
+ If dictAllMaterials.Exists(code) Then
+ Set mat = dictAllMaterials(code)
+ mat.Category = catName ' 设置物料所属类别
+ mat.ParentCategory = parentCatName ' 设置物料的上层类别
+ dictCategories(catName).AddMaterial mat ' 将物料添加到类别对象中
+ End If
+
+NextRow:
+ Next i
+
+ ' ========================================
+ ' 第三步: 建立类别层级关系
+ ' 说明:
+ ' - 遍历所有类别,根据ParentCategoryName建立父子关系
+ ' - 如果类别有父类别,将自己添加到父类别的SubCategories中
+ ' - 如果类别没有父类别,则为根类别,添加到rootCategories中
+ ' 结果:
+ ' - 构建完整的树形结构
+ ' - rootCategories包含所有顶层类别
+ ' - 每个类别的SubCategories包含其直接子类别
+ ' ========================================
+ Dim key As Variant
+ For Each key In dictCategories.Keys
+ Set cat = dictCategories(key)
+ If cat.ParentCategoryName <> "" Then
+ ' 有父类别,建立父子关系
+ If dictCategories.Exists(cat.ParentCategoryName) Then
+ Dim parentCat As clsCategory
+ Set parentCat = dictCategories(cat.ParentCategoryName)
+ parentCat.AddSubCategory cat ' 将当前类别添加为父类别的子类别
+ End If
+ Else
+ ' 无父类别,是根类别
+ rootCategories.Add cat, cat.categoryName
+ End If
+ Next key
+End Sub
+
+' ========================================
+' GetRootCategories 方法
+' 功能: 获取所有顶层类别的集合
+' 返回: Collection对象,包含所有无父类别的clsCategory对象
+' 用途:
+' - 遍历整个BOM结构时的入口点
+' - 生成领料清单时遍历所有根类别
+' 示例:
+' Dim cats As Collection
+' Set cats = bomMgr.GetRootCategories()
+' For i = 1 To cats.Count
+' Debug.Print cats(i).CategoryName
+' Next i
+' ========================================
+Public Function GetRootCategories() As collection
+ Set GetRootCategories = rootCategories
+End Function
+
+' ========================================
+' GetCategory 方法
+' 功能: 根据类别名称获取类别对象
+' 参数:
+' categoryName - 要查询的类别名称(字符串)
+' 返回:
+' clsCategory对象 - 如果找到
+' Nothing - 如果未找到
+' 用途: 快速查找特定类别及其下的物料
+' 示例:
+' Dim cat As clsCategory
+' Set cat = bomMgr.GetCategory("部件")
+' If Not cat Is Nothing Then
+' Debug.Print cat.Materials.Count & " 个物料"
+' End If
+' ========================================
+Public Function GetCategory(categoryName As String) As clsCategory
+ If dictCategories.Exists(categoryName) Then
+ Set GetCategory = dictCategories(categoryName)
+ Else
+ Set GetCategory = Nothing
+ End If
+End Function
+
+' ========================================
+' GetMaterialsForPicking 方法
+' 功能: 获取某类别下需要领料的物料清单(考虑层级逻辑)
+' 参数:
+' categoryName - 类别名称
+' useParent - 可选参数,默认True
+' True: 使用父类别物料(默认领料方式)
+' False: 使用子类别物料(库存不足时的替代方案)
+' 返回: Collection对象,包含clsMaterialItem对象
+'
+' 业务逻辑说明:
+' 1. 默认领取父类别的物料(如"低压接头部件")
+' 2. 当父类别库存不足时,才领取子类别的物料(如"接头"+"弹性元件")
+' 3. 如果useParent=True但类别有子类别,仍返回父类别物料
+' 4. 如果useParent=False,递归获取所有子类别的物料
+'
+' 示例1: 获取"部件"类别的物料(父类别)
+' Set mats = bomMgr.GetMaterialsForPicking("部件", True)
+' ' 返回: 低压接头部件、高压接头部件等组装好的部件
+'
+' 示例2: 获取"部件"类别的物料(子类别展开)
+' Set mats = bomMgr.GetMaterialsForPicking("部件", False)
+' ' 返回: 径向低压接头、弹簧管、螺旋管等零件
+' ========================================
+Public Function GetMaterialsForPicking(categoryName As String, _
+ Optional useParent As Boolean = True) As collection
+ Dim result As collection
+ Set result = New collection
+
+ ' 查找指定类别
+ Dim cat As clsCategory
+ Set cat = GetCategory(categoryName)
+ If cat Is Nothing Then
+ ' 类别不存在,返回空集合
+ Set GetMaterialsForPicking = result
+ Exit Function
+ End If
+
+ Dim i As Long
+
+ If useParent Then
+ ' ========================================
+ ' 使用父类别物料(默认领料方式)
+ ' 说明:
+ ' - 直接返回当前类别下的所有物料
+ ' - 即使该类别有子类别,也仍然返回父类别物料
+ ' - 这是正常情况下的领料方式(领取组装好的部件)
+ ' ========================================
+ Dim m As clsMaterialItem
+ For i = 1 To cat.materials.Count
+ Set m = cat.materials(i)
+ result.Add m
+ Next i
+ Else
+ ' ========================================
+ ' 使用子类别物料(库存不足时的替代方案)
+ ' 说明:
+ ' - 如果当前类别有子类别,递归获取所有子类别的物料
+ ' - 如果当前类别是叶子类别(无子类别),返回本类别物料
+ ' - 这用于父类别库存不足,需要领取零件自行组装的情况
+ ' 示例:
+ ' 当"低压接头部件"库存不足时
+ ' 改为领取"径向低压接头"+"弹簧管"零件
+ ' ========================================
+ If cat.HasSubCategories Then
+ ' 有子类别,递归获取所有子类别的物料
+ Dim subCat As clsCategory
+ Dim j As Long
+ For j = 1 To cat.SubCategories.Count
+ Set subCat = cat.SubCategories(j)
+ Dim subMats As collection
+ ' 递归调用,继续展开子类别
+ Set subMats = GetMaterialsForPicking(subCat.categoryName, False)
+ Dim k As Long
+ For k = 1 To subMats.Count
+ result.Add subMats(k)
+ Next k
+ Next j
+ Else
+ ' 叶子类别,返回本类别物料
+ For i = 1 To cat.materials.Count
+ Set m = cat.materials(i)
+ result.Add m
+ Next i
+ End If
+ End If
+
+ Set GetMaterialsForPicking = result
+End Function
+
+' ========================================
+' PrintCategoryTree 方法
+' 功能: 将类别树结构打印到工作表(用于调试和查看)
+' 参数:
+' ws - 输出的目标工作表对象
+' 输出格式:
+' - 第一列: 类别名称(带缩进显示层级)
+' - 第二列: 物料数量信息
+' - 第三列: 选择条件
+' 说明:
+' - 使用缩进显示类别层级(每层2个空格)
+' - 递归打印所有子类别和物料
+' - 便于验证数据结构是否正确
+' 示例输出:
+' 表壳 (物料数:1)
+' - 01091004312 表壳(本色) 数量:1 条件:
+' 部件 (物料数:20)
+' - 01011019001 低压接头部件 数量:1 条件:lcfw=M02...
+' 接头 (物料数:18)
+' - 01081013833 径向低压接头 数量:1 条件:gclj=Z12...
+' ========================================
+Public Sub PrintCategoryTree(ws As Worksheet)
+ Dim row As Long
+ row = 1
+ ws.Cells(row, 1).value = "类别层级结构"
+ row = row + 1
+
+ ' 遍历所有根类别,递归打印整个树
+ Dim rootCat As clsCategory
+ Dim i As Long
+ For i = 1 To rootCategories.Count
+ Set rootCat = rootCategories(i)
+ Call PrintCategory(ws, rootCat, row, 0)
+ Next i
+End Sub
+
+' ========================================
+' PrintCategory 方法 (私有方法)
+' 功能: 递归打印单个类别及其子类别(供PrintCategoryTree调用)
+' 参数:
+' ws - 输出的工作表对象
+' cat - 要打印的类别对象
+' row - 当前输出行号(ByRef,会被修改)
+' level - 当前层级深度(0=根类别,1=一级子类别...)
+' 说明:
+' - 使用递归方式遍历整个类别树
+' - 根据level参数计算缩进空格数
+' - 先打印类别名,再打印该类别的所有物料,最后递归打印子类别
+' ========================================
+Private Sub PrintCategory(ws As Worksheet, cat As clsCategory, _
+ ByRef row As Long, level As Integer)
+ ' 计算缩进(每层2个空格)
+ Dim indent As String
+ indent = String(level * 2, " ")
+
+ ' 打印类别名称和物料数量统计
+ ws.Cells(row, 1).value = indent & cat.categoryName & _
+ " (物料数:" & cat.materials.Count & ")"
+ row = row + 1
+
+ ' 打印该类别下的所有物料
+ Dim mat As clsMaterialItem
+ Dim i As Long
+ For i = 1 To cat.materials.Count
+ Set mat = cat.materials(i)
+ ' 物料行额外缩进2个空格,并加上"- "前缀
+ ws.Cells(row, 1).value = indent & " - " & mat.code & " " & mat.Name
+ ws.Cells(row, 2).value = "数量:" & mat.Quantity
+ ws.Cells(row, 3).value = "条件:" & mat.Condition
+ row = row + 1
+ Next i
+
+ ' 递归打印所有子类别
+ Dim subCat As clsCategory
+ Dim j As Long
+ For j = 1 To cat.SubCategories.Count
+ Set subCat = cat.SubCategories(j)
+ ' 递归调用,层级加1
+ Call PrintCategory(ws, subCat, row, level + 1)
+ Next j
+End Sub
+' ========================================
+' GetMaterialsByModel 方法
+'
+' 【功能概述】
+' 根据产品型号字符串自动解析规格参数,并返回符合这些规格的所有物料清单。
+' 这是BOM系统的核心方法,实现了从"产品型号"到"物料清单"的智能转换。
+'
+' 【工作流程】
+' 1. 型号解析 (clsModelParser) → 将产品型号字符串拆解为结构化参数
+' 2. 条件提取 (clsConditionExtractor) → 从型号参数中提取匹配条件变量
+' 3. 物料筛选 (clsConditionMatcher) → 根据条件从物料库中筛选符合条件的物料
+'
+' 【参数说明】
+' modelStr - 产品型号字符串
+' 格式: [型号]-[口径].[安装].[表壳].[连接].[量程]|[表盘]|[附件]|[法兰]
+' 示例: "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
+' 说明: 必须是完整的型号字符串,不能为空
+'
+' categoryName - 类别名称(可选参数,默认为空字符串)
+' 为空字符串 "": 返回所有类别的符合条件物料(默认行为)
+' 指定类别名: 仅返回该类别下的符合条件物料
+' 示例: "部件"、"表壳"、"接头"、"机芯"
+'
+' autoFallback - 是否自动降级到子类别(可选参数,默认为True)
+' True (默认): 当某个类别无匹配物料时,自动降级到其子类别继续查找
+' False: 仅在当前类别查找,不降级到子类别
+' 示例场景:
+' 型号 "YTHN-100.A0.532.M203.M17.Y3" 的量程是M17
+' 类别"部件"下的物料条件是 "lcfw=M02"
+' autoFallback=True: 自动降级到子类别"接头"、"弹性元件"等查找
+' autoFallback=False: "部件"类别返回空集合
+'
+' 【返回值】
+' 返回类型: Collection对象
+' 元素类型: Collection中的每个元素都是 clsMaterialItem 对象
+'
+' clsMaterialItem 对象属性:
+' .code - String - 物料代号(如: "01011019001")
+' .Name - String - 物料名称(如: "低压接头部件")
+' .Quantity - Double - 物料数量(如: 1, 2, 0.5)
+' .Condition - String - 选择条件(如: "lcfw=M02 AND gclj=Z12")
+' .Category - String - 所属类别名称
+' .ParentCategory - String - 上层类别名称
+'
+' 【注意事项】
+' 1. 调用前必须先执行 LoadData() 方法加载BOM数据
+' 2. 型号字符串必须完整且符合格式要求
+' 3. 返回的Collection可能为空(没有符合条件的物料),需要判断Count属性
+' 4. 调试信息会输出到VBA的"立即窗口"(Ctrl+G查看)
+' 5. 物料的Condition属性为空表示该物料无条件限制(所有型号都使用)
+' 6. autoFallback 参数影响查找范围:
+' - True (默认): 会返回父类别和子类别的物料,更全面但可能包含不需要的物料
+' - False: 仅返回指定类别的物料,更精确但可能遗漏子类别的替代物料
+'
+' 【相关方法】
+' - GetMaterialsByCategoryAndModel: 结合了类别层级逻辑的物料获取
+' - GetMaterialsForPicking: 纯粹按类别获取物料(不进行型号匹配)
+' - ParseModelAndExtractConditions: 仅解析型号并返回条件字典
+' ========================================
+Public Function GetMaterialsByModel(modelStr As String, _
+ Optional categoryName As String = "", _
+ Optional autoFallback As Boolean = True) As collection
+ Dim result As collection
+ Set result = New collection
+
+ ' ========================================
+ ' 第1步: 解析型号并提取条件
+ ' ========================================
+ Dim parser As New clsModelParser
+ If Not parser.ParseModel(modelStr) Then
+ Debug.Print "型号解析失败: " & parser.ErrorMessage
+ Set GetMaterialsByModel = result
+ Exit Function
+ End If
+
+ Dim extractor As New clsConditionExtractor
+ Dim conditions As Object
+ Set conditions = extractor.ExtractConditions(parser)
+
+ ' 调试输出
+ Debug.Print "【型号】: " & modelStr
+ Debug.Print "【提取的条件】:"
+ Dim key As Variant
+ For Each key In conditions.Keys
+ Debug.Print " " & key & " = " & conditions(key)
+ Next key
+ Debug.Print ""
+
+ ' ========================================
+ ' 第2步: 按类别筛选物料（根据参数决定是否自动降级到子类别）
+ ' ========================================
+ Dim matcher As New clsConditionMatcher
+ Dim totalMatchCount As Long
+ Dim catResult As collection ' 提前声明，避免在If/Else中重复声明
+ Dim cat As clsCategory
+ Dim rootCat As clsCategory
+ Dim i As Long, j As Long
+ totalMatchCount = 0
+
+ If autoFallback Then
+ Debug.Print "【降级模式】启用自动降级到子类别"
+ Else
+ Debug.Print "【降级模式】禁用自动降级，仅查找当前类别"
+ End If
+ Debug.Print ""
+
+ If categoryName <> "" Then
+ ' ========================================
+ ' 情况A: 指定了类别名称
+ ' 只在该类别及其子类别中查找
+ ' ========================================
+ Set cat = GetCategory(categoryName)
+
+ If Not cat Is Nothing Then
+ ' 从该类别开始查找（根据参数决定是否启用子类别降级逻辑）
+ Set catResult = FilterCategoryWithSubcategories(cat, matcher, conditions, autoFallback)
+
+ ' 合并结果
+ For i = 1 To catResult.Count
+ result.Add catResult(i)
+ Next i
+ totalMatchCount = catResult.Count
+ End If
+ Else
+ ' ========================================
+ ' 情况B: 未指定类别名称
+ ' 遍历所有根类别，对每个类别应用子类别降级逻辑
+ ' ========================================
+ For j = 1 To rootCategories.Count
+ Set rootCat = rootCategories(j)
+
+ ' 对每个根类别应用筛选（根据参数决定是否启用子类别降级逻辑）
+ Set catResult = FilterCategoryWithSubcategories(rootCat, matcher, conditions, autoFallback)
+
+ ' 合并结果
+ For i = 1 To catResult.Count
+ result.Add catResult(i)
+ Next i
+ totalMatchCount = totalMatchCount + catResult.Count
+ Next j
+ End If
+
+ Debug.Print "共匹配 " & totalMatchCount & " 个物料"
+ Debug.Print String(60, "=")
+
+ Set GetMaterialsByModel = result
+End Function
+
+' ========================================
+' FilterCategoryWithSubcategories 方法 (私有)
+' 功能: 对指定类别进行筛选，根据参数决定是否自动降级到子类别
+' 参数:
+' cat - 类别对象
+' matcher - 条件匹配器对象
+' conditions - 提取的条件字典
+' autoFallback - 是否自动降级到子类别（默认True）
+' True: 当前类别无匹配时，自动降级到子类别查找
+' False: 仅在当前类别查找，不降级到子类别
+' 返回: Collection对象，包含匹配的物料
+'
+' 工作逻辑:
+' 1. 先尝试在当前类别下筛选物料
+' 2. 如果当前类别有匹配结果，直接返回
+' 3. 如果当前类别无匹配结果且 autoFallback=True，检查是否有子类别
+' 4. 如果有子类别且允许降级，递归对所有子类别进行筛选
+' 5. 如果无子类别或不允许降级，返回当前结果
+'
+' 示例场景:
+' 型号: "YTHN-100.A0.532.M203.M16.Y3"
+' 类别"部件"下有物料"低压接头部件"（条件: lcfw=M02）
+' 如果该型号的量程不是M02，则"部件"类别无匹配
+' 当 autoFallback=True 时，自动降级到子类别"接头"、"弹性元件"等查找
+' 当 autoFallback=False 时，返回空集合，不查找子类别
+' ========================================
+Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _
+ ByVal matcher As clsConditionMatcher, _
+ ByVal conditions As Object, _
+ ByVal autoFallback As Boolean) As collection
+ Dim result As collection
+ Set result = New collection
+
+ ' 类别不存在，返回空集合
+ If cat Is Nothing Then
+ Set FilterCategoryWithSubcategories = result
+ Exit Function
+ End If
+
+ ' ========================================
+ ' 第一阶段: 尝试在当前类别下筛选
+ ' ========================================
+ Dim mat As clsMaterialItem
+ Dim i As Long
+ Dim matchCount As Long
+ matchCount = 0
+
+ ' 遍历当前类别的所有物料进行筛选
+ For i = 1 To cat.materials.Count
+ Set mat = cat.materials(i)
+ If matcher.IsMatch(mat.Condition, conditions) Then
+ result.Add mat
+ matchCount = matchCount + 1
+
+ ' 调试输出
+ Debug.Print "【匹配】" & cat.categoryName & " > " & _
+ mat.code & " - " & mat.Name & _
+ " | 条件: " & IIf(mat.Condition = "", "(无)", mat.Condition)
+ End If
+ Next i
+
+ ' ========================================
+ ' 第二阶段: 如果当前类别无匹配且允许降级，检查子类别
+ ' ========================================
+ If matchCount = 0 And cat.HasSubCategories And autoFallback Then
+ Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..."
+
+ ' 递归处理所有子类别
+ Dim subCat As clsCategory
+ Dim j As Long
+ For j = 1 To cat.SubCategories.Count
+ Set subCat = cat.SubCategories(j)
+
+ ' 递归调用，获取子类别的匹配结果（传递相同的 autoFallback 参数）
+ Dim subResult As collection
+ Set subResult = FilterCategoryWithSubcategories(subCat, matcher, conditions, autoFallback)
+
+ ' 合并子类别的结果
+ Dim k As Long
+ For k = 1 To subResult.Count
+ result.Add subResult(k)
+ Next k
+ Next j
+ ElseIf matchCount = 0 And cat.HasSubCategories And Not autoFallback Then
+ Debug.Print "【跳过】类别 """ & cat.categoryName & """ 无匹配物料，但降级已禁用，不查找子类别"
+ ElseIf matchCount > 0 Then
+ Debug.Print "【成功】类别 """ & cat.categoryName & """ 匹配 " & matchCount & " 个物料"
+ End If
+
+ Set FilterCategoryWithSubcategories = result
+End Function
+
+' ========================================
+' CollectAllMaterials 方法 (私有)
+' 功能: 递归收集类别及其所有子类别的物料
+' 参数:
+' cat - 类别对象
+' collection - 用于存储物料的Collection
+' ========================================
+Private Sub CollectAllMaterials(cat As clsCategory, collection As collection)
+ Dim i As Long
+
+ ' 添加当前类别的所有物料
+ For i = 1 To cat.materials.Count
+ collection.Add cat.materials(i)
+ Next i
+
+ ' 递归处理子类别
+ Dim subCat As clsCategory
+ Dim j As Long
+ For j = 1 To cat.SubCategories.Count
+ Set subCat = cat.SubCategories(j)
+ Call CollectAllMaterials(subCat, collection)
+ Next j
+End Sub
+
+' ========================================
+' GetMaterialsByCategoryAndModel 方法
+' 功能: 根据类别和型号获取物料（使用父类别或子类别逻辑）
+' 参数:
+' modelStr - 产品型号字符串
+' categoryName - 类别名称
+' useParent - True=使用父类别物料，False=使用子类别物料
+' 返回: Collection对象，包含符合条件的clsMaterialItem对象
+' 说明: 这是 GetMaterialsForPicking 和 GetMaterialsByModel 的结合
+' ========================================
+Public Function GetMaterialsByCategoryAndModel(modelStr As String, _
+ categoryName As String, _
+ Optional useParent As Boolean = True) As collection
+ Dim result As collection
+ Set result = New collection
+
+ ' 1. 解析型号并提取条件
+ Dim parser As New clsModelParser
+ If Not parser.ParseModel(modelStr) Then
+ Set GetMaterialsByCategoryAndModel = result
+ Exit Function
+ End If
+
+ Dim extractor As New clsConditionExtractor
+ Dim conditions As Object
+ Set conditions = extractor.ExtractConditions(parser)
+
+ ' 2. 获取类别的物料（根据 useParent 参数）
+ Dim materialsToFilter As collection
+ Set materialsToFilter = GetMaterialsForPicking(categoryName, useParent)
+
+ ' 3. 筛选符合条件的物料
+ Dim matcher As New clsConditionMatcher
+ Dim mat As clsMaterialItem
+
+ For Each mat In materialsToFilter
+ If matcher.IsMatch(mat.Condition, conditions) Then
+ result.Add mat
+ End If
+ Next mat
+
+ Set GetMaterialsByCategoryAndModel = result
+End Function
+
+' ========================================
+' ParseModelAndExtractConditions 方法
+' 功能: 解析型号并返回条件字典（工具方法）
+' 参数: modelStr - 产品型号字符串
+' 返回: Dictionary对象，包含提取的条件
+' 用途: 供外部调用，用于查看提取的条件
+' ========================================
+Public Function ParseModelAndExtractConditions(modelStr As String) As Object
+ Dim parser As New clsModelParser
+ Dim extractor As New clsConditionExtractor
+ Dim conditions As Object
+
+ If parser.ParseModel(modelStr) Then
+ Set conditions = extractor.ExtractConditions(parser)
+ Else
+ Set conditions = CreateObject("Scripting.Dictionary")
+ End If
+
+ Set ParseModelAndExtractConditions = conditions
+End Function
+
+' ========================================
+' GetValidMaterialsByModel 方法
+' 功能: 根据产品型号获取物料，并判断是否为完整的物料集合
+' 参数:
+' modelStr - 产品型号字符串
+' 返回: Collection对象
+' Collection中包含两个元素:
+' (1) "Materials" - Collection对象,包含所有匹配的 clsMaterialItem 对象
+' (2) "IsComplete" - Boolean值,指示物料是否完整
+'
+' 完整性判断规则:
+' - 对于每个需要领料的类别(顶层类别或其需要领取的子类别)
+' - 必须有且仅有一个物料被匹配
+' - 如果某个类别有0个或多于1个物料,则视为不完整
+'
+' 示例:
+' Dim result As Collection
+' Set result = bomMgr.GetValidMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3")
+' Dim materials As Collection
+' Dim isComplete As Boolean
+' Set materials = result("Materials")
+' isComplete = result("IsComplete")
+' ========================================
+Public Function GetValidMaterialsByModel(modelStr As String) As collection
+ Dim result As New collection
+ Dim allMaterials As New collection
+ Dim isComplete As Boolean
+
+ ' 解析型号并提取条件
+ Dim parser As New clsModelParser
+ If Not parser.ParseModel(modelStr) Then
+ Debug.Print "型号解析失败: " & parser.ErrorMessage
+ isComplete = False
+ result.Add allMaterials, "Materials"
+ result.Add isComplete, "IsComplete"
+ Set GetValidMaterialsByModel = result
+ Exit Function
+ End If
+
+ Dim extractor As New clsConditionExtractor
+ Dim conditions As Object
+ Set conditions = extractor.ExtractConditions(parser)
+
+ ' 调试输出
+ Debug.Print "【GetValidMaterialsByModel】"
+ Debug.Print "型号: " & modelStr
+ Debug.Print "提取的条件:"
+ Dim key As Variant
+ For Each key In conditions.Keys
+ Debug.Print " " & key & " = " & conditions(key)
+ Next key
+ Debug.Print ""
+
+ ' 条件匹配器
+ Dim matcher As New clsConditionMatcher
+
+ ' 遍历所有根类别,检查完整性
+ isComplete = True
+ Dim categoryCheckResults As Object
+ Set categoryCheckResults = CreateObject("Scripting.Dictionary")
+
+ Dim rootCat As clsCategory
+ Dim i As Long
+ For i = 1 To rootCategories.count
+ Set rootCat = rootCategories(i)
+
+ ' 检查该类别及其子类别的完整性
+ Dim catResult As Object
+ Set catResult = CheckCategoryCompleteness(rootCat, matcher, conditions)
+
+ ' 合并物料
+ Dim mat As clsMaterialItem
+ Dim matCollection As collection
+ Set matCollection = catResult("Materials")
+ For Each mat In matCollection
+ allMaterials.Add mat
+ Next mat
+
+ ' 检查完整性
+ If Not catResult("IsComplete") Then
+ isComplete = False
+ Debug.Print "【不完整】类别 """ & rootCat.categoryName & """ 物料不完整"
+ End If
+
+ ' 保存类别检查结果(用于调试)
+ categoryCheckResults(rootCat.categoryName) = catResult("IsComplete")
+ Next i
+
+ ' 调试输出总结
+ Debug.Print ""
+ Debug.Print "【完整性检查结果】"
+ Debug.Print "总物料数: " & allMaterials.count
+ Debug.Print "是否完整: " & IIf(isComplete, "是", "否")
+ For Each key In categoryCheckResults.Keys
+ Debug.Print " " & key & ": " & IIf(categoryCheckResults(key), "完整", "不完整")
+ Next key
+ Debug.Print String(60, "=")
+
+ ' 返回结果
+ result.Add allMaterials, "Materials"
+ result.Add isComplete, "IsComplete"
+ Set GetValidMaterialsByModel = result
+End Function
+
+' ========================================
+' CheckCategoryCompleteness 方法 (私有)
+' 功能: 检查单个类别的完整性(递归处理子类别)
+' 参数:
+' cat - 类别对象
+' matcher - 条件匹配器
+' conditions - 提取的条件字典
+' 返回: Dictionary对象
+' "Materials" - Collection,包含该类别匹配的物料
+' "IsComplete" - Boolean,该类别是否完整
+'
+' 完整性判断逻辑:
+' 1. 如果类别没有子类别(叶子类别):
+' - 必须有且仅有1个物料匹配 → 完整
+' - 0个或多于1个物料 → 不完整
+'
+' 2. 如果类别有子类别:
+' a) 先尝试在父类别查找物料
+' b) 如果父类别有且仅有1个匹配物料 → 使用父类别,完整
+' c) 如果父类别没有匹配物料 → 降级到所有子类别
+' - 每个子类别都必须有且仅有1个匹配物料 → 完整
+' - 任一子类别不满足 → 不完整
+' ========================================
+Private Function CheckCategoryCompleteness(cat As clsCategory, _
+ matcher As clsConditionMatcher, _
+ conditions As Object) As Object
+ Dim result As Object
+ Set result = CreateObject("Scripting.Dictionary")
+
+ Dim materials As New collection
+ Dim isComplete As Boolean
+
+ ' 首先在当前类别查找匹配的物料
+ Dim mat As clsMaterialItem
+ Dim matchCount As Long
+ matchCount = 0
+
+ Dim i As Long
+ For i = 1 To cat.materials.count
+ Set mat = cat.materials(i)
+ If matcher.IsMatch(mat.Condition, conditions) Then
+ materials.Add mat
+ matchCount = matchCount + 1
+ End If
+ Next i
+
+ ' 判断完整性
+ If Not cat.HasSubCategories Then
+ ' ========================================
+ ' 情况1: 叶子类别(无子类别)
+ ' 必须有且仅有1个物料
+ ' ========================================
+ If matchCount = 1 Then
+ isComplete = True
+ Debug.Print "【完整】叶子类别 """ & cat.categoryName & """ 有1个匹配物料"
+ Else
+ isComplete = False
+ If matchCount = 0 Then
+ Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 无匹配物料"
+ Else
+ Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为1个)"
+ End If
+ End If
+ Else
+ ' ========================================
+ ' 情况2: 有子类别
+ ' 先检查父类别,如果父类别满足则使用父类别
+ ' 否则降级到子类别,每个子类别都必须满足
+ ' ========================================
+ If matchCount = 1 Then
+ ' 父类别有且仅有1个物料,使用父类别
+ isComplete = True
+ Debug.Print "【完整】父类别 """ & cat.categoryName & """ 有1个匹配物料,使用父类别"
+ ElseIf matchCount = 0 Then
+ ' 父类别无匹配物料,降级到子类别
+ Debug.Print "【降级】父类别 """ & cat.categoryName & """ 无匹配物料,检查子类别..."
+
+ ' 清空物料集合,准备收集子类别物料
+ Set materials = New collection
+ isComplete = True ' 假设完整,如果任一子类别不完整则设为False
+
+ Dim subCat As clsCategory
+ Dim j As Long
+ For j = 1 To cat.SubCategories.count
+ Set subCat = cat.SubCategories(j)
+
+ ' 递归检查子类别
+ Dim subResult As Object
+ Set subResult = CheckCategoryCompleteness(subCat, matcher, conditions)
+
+ ' 合并子类别物料
+ Dim subMaterials As collection
+ Set subMaterials = subResult("Materials")
+ Dim k As Long
+ For k = 1 To subMaterials.count
+ materials.Add subMaterials(k)
+ Next k
+
+ ' 检查子类别是否完整
+ If Not subResult("IsComplete") Then
+ isComplete = False
+ End If
+ Next j
+
+ If isComplete Then
+ Debug.Print "【完整】类别 """ & cat.categoryName & """ 所有子类别都完整"
+ Else
+ Debug.Print "【不完整】类别 """ & cat.categoryName & """ 存在不完整的子类别"
+ End If
+ Else
+ ' 父类别有多个匹配物料,不完整
+ isComplete = False
+ Debug.Print "【不完整】父类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为0或1个)"
+ End If
+ End If
+
+ ' 返回结果
+ Set result("Materials") = materials
+ result("IsComplete") = isComplete
+ Set CheckCategoryCompleteness = result
+End Function
+```
+
+## ClassModules\clsCategory.cls
+
+```
+' ========================================
+' 类模块: clsCategory
+' 用途: 表示物料类别及其层级关系
+' ========================================
+Option Explicit
+
+Public categoryName As String
+Public ParentCategoryName As String
+Public materials As collection ' 存储 clsMaterialItem 对象
+Public SubCategories As collection ' 存储子类别 clsCategory 对象
+Public IsLeafCategory As Boolean ' 是否叶子类别(无子类别)
+
+Private Sub Class_Initialize()
+ Set materials = New collection
+ Set SubCategories = New collection
+ IsLeafCategory = True
+End Sub
+
+' 添加物料
+Public Sub AddMaterial(mat As clsMaterialItem)
+ materials.Add mat, mat.code
+End Sub
+
+' 添加子类别
+Public Sub AddSubCategory(cat As clsCategory)
+ SubCategories.Add cat, cat.categoryName
+ IsLeafCategory = False
+End Sub
+
+' 获取物料(按代号)
+Public Function GetMaterial(code As String) As clsMaterialItem
+ On Error Resume Next
+ Set GetMaterial = materials(code)
+ On Error GoTo 0
+End Function
+
+' 检查是否有子类别
+Public Function HasSubCategories() As Boolean
+ HasSubCategories = (SubCategories.Count > 0)
+End Function
+```
+
+## ClassModules\clsConditionExtractor.cls
+
+```
+' ========================================
+' 类模块: clsConditionExtractor
+' 用途: 从型号解析器中提取物料选择条件
+' ========================================
+Option Explicit
+
+' ========================================
+' 私有成员变量
+' ========================================
+Private m_Conditions As Object ' Dictionary: 变量名 -> 条件值
+Private m_ExtractionRules As Object ' Dictionary: 提取规则配置
+
+' ========================================
+' 类初始化
+' ========================================
+Private Sub Class_Initialize()
+ Set m_Conditions = CreateObject("Scripting.Dictionary")
+ Set m_ExtractionRules = CreateObject("Scripting.Dictionary")
+
+ ' 初始化提取规则
+ InitializeRules
+End Sub
+
+' ========================================
+' InitializeRules 方法 (私有)
+' 功能: 初始化条件提取规则
+' 说明: 这里配置所有需要提取的条件及其提取方法
+' ========================================
+Private Sub InitializeRules()
+ ' 规则格式: Dictionary(变量名) = Array(源字段, 提取方法)
+
+ ' 规则1: 过程连接 (gclj)
+ ' 从 ConnectionCode 中提取，去掉最后一位数字
+ m_ExtractionRules("gclj") = Array("ConnectionCode", "RemoveLastDigit")
+
+ ' 规则2: 接液材质 (jycz)
+ ' 从 ConnectionCode 中提取，取最后一位数字
+ m_ExtractionRules("jycz") = Array("ConnectionCode", "GetLastDigit")
+
+ ' 规则3: 量程范围 (lcfw)
+ ' 从 RangeCode 中直接提取
+ m_ExtractionRules("lcfw") = Array("RangeCode", "Direct")
+
+ ' 未来可以在这里添加更多提取规则...
+ ' 例如:
+ ' m_ExtractionRules("bplx") = Array("DialCode", "Direct") ' 表盘类型
+End Sub
+
+' ========================================
+' ExtractConditions 方法
+' 功能: 从型号解析器中提取所有条件
+' 参数: parser - clsModelParser对象
+' 返回: Dictionary对象，包含所有提取的条件
+' ========================================
+Public Function ExtractConditions(parser As clsModelParser) As Object
+ ' 清空现有条件
+ Set m_Conditions = CreateObject("Scripting.Dictionary")
+
+ ' 验证解析器有效性
+ If Not parser.IsValid Then
+ Set ExtractConditions = m_Conditions
+ Exit Function
+ End If
+
+ ' 遍历所有提取规则
+ Dim varName As Variant
+ For Each varName In m_ExtractionRules.Keys
+ Dim ruleInfo As Variant
+ ruleInfo = m_ExtractionRules(varName)
+
+ Dim sourceField As String
+ Dim extractMethod As String
+ sourceField = ruleInfo(0)
+ extractMethod = ruleInfo(1)
+
+ ' 提取条件值
+ Dim conditionValue As String
+ conditionValue = ExtractValue(parser, sourceField, extractMethod)
+
+ ' 添加到条件字典
+ If conditionValue <> "" Then
+ m_Conditions(CStr(varName)) = conditionValue
+ End If
+ Next varName
+
+ Set ExtractConditions = m_Conditions
+End Function
+
+' ========================================
+' ExtractValue 方法 (私有)
+' 功能: 根据规则从解析器中提取单个值
+' 参数:
+' parser - clsModelParser对象
+' sourceField - 源字段名称
+' extractMethod - 提取方法名称
+' 返回: 提取的条件值
+' ========================================
+Private Function ExtractValue(parser As clsModelParser, _
+ sourceField As String, _
+ extractMethod As String) As String
+ Dim sourceValue As String
+
+ ' 获取源字段值
+ Select Case sourceField
+ Case "ConnectionCode"
+ sourceValue = parser.ConnectionCode
+ Case "RangeCode"
+ sourceValue = parser.RangeCode
+ Case "ModelType"
+ sourceValue = parser.ModelType
+ Case "Diameter"
+ sourceValue = parser.Diameter
+ Case "InstallForm"
+ sourceValue = parser.InstallForm
+ Case "ShellForm"
+ sourceValue = parser.ShellForm
+ Case "Characteristics"
+ sourceValue = parser.Characteristics
+ Case Else
+ sourceValue = ""
+ End Select
+
+ ' 应用提取方法
+ Select Case extractMethod
+ Case "Direct"
+ ' 直接使用
+ ExtractValue = sourceValue
+
+ Case "RemoveLastDigit"
+ ' 去掉最后一位字符
+ If Len(sourceValue) > 1 Then
+ ExtractValue = Left(sourceValue, Len(sourceValue) - 1)
+ Else
+ ExtractValue = sourceValue
+ End If
+
+ Case "GetLastDigit"
+ ' 取最后一位字符
+ If Len(sourceValue) > 0 Then
+ ExtractValue = Right(sourceValue, 1)
+ Else
+ ExtractValue = ""
+ End If
+
+ Case "GetFirstChar"
+ ' 取第一个字符
+ If Len(sourceValue) > 0 Then
+ ExtractValue = Left(sourceValue, 1)
+ Else
+ ExtractValue = ""
+ End If
+
+ Case Else
+ ' 未知方法，返回空
+ ExtractValue = ""
+ End Select
+End Function
+
+' ========================================
+' GetConditionValue 方法
+' 功能: 获取单个条件值
+' 参数: varName - 变量名
+' 返回: 条件值，如果不存在返回空字符串
+' ========================================
+Public Function GetConditionValue(varName As String) As String
+ If m_Conditions.Exists(varName) Then
+ GetConditionValue = m_Conditions(varName)
+ Else
+ GetConditionValue = ""
+ End If
+End Function
+
+' ========================================
+' AddCondition 方法
+' 功能: 手动添加条件 (用于特殊情况)
+' 参数:
+' varName - 变量名
+' value - 条件值
+' ========================================
+Public Sub AddCondition(varName As String, value As String)
+ m_Conditions(varName) = value
+End Sub
+
+' ========================================
+' GetConditions 属性
+' 功能: 获取所有条件的Dictionary对象
+' ========================================
+Public Property Get conditions() As Object
+ Set conditions = m_Conditions
+End Property
+
+' ========================================
+' ToString 方法
+' 功能: 返回条件的字符串表示 (用于调试)
+' ========================================
+Public Function ToString() As String
+ Dim result As String
+ result = "【提取的条件】" & vbCrLf
+
+ If m_Conditions.Count = 0 Then
+ result = result & " (无条件)" & vbCrLf
+ Else
+ Dim key As Variant
+ For Each key In m_Conditions.Keys
+ result = result & " " & key & " = " & m_Conditions(key) & vbCrLf
+ Next key
+ End If
+
+ ToString = result
+End Function
+
+' ========================================
+' AddExtractionRule 方法
+' 功能: 动态添加新的提取规则 (用于扩展)
+' 参数:
+' varName - 变量名
+' sourceField - 源字段名称
+' extractMethod - 提取方法名称
+' 示例: extractor.AddExtractionRule "bplx", "DialCode", "Direct"
+' ========================================
+Public Sub AddExtractionRule(varName As String, _
+ sourceField As String, _
+ extractMethod As String)
+ m_ExtractionRules(varName) = Array(sourceField, extractMethod)
+End Sub
+
+' ========================================
+' GetExtractionRules 方法
+' 功能: 获取当前所有提取规则 (用于调试)
+' 返回: Dictionary对象
+' ========================================
+Public Function GetExtractionRules() As Object
+ Set GetExtractionRules = m_ExtractionRules
+End Function
+```
+
+## ClassModules\clsConditionMatcher.cls
+
+```
+' ========================================
+' 类模块: clsConditionMatcher
+' 用途: 解析物料的选择条件表达式，并判断是否匹配
+' 支持: AND, OR, NOT(!=), 括号优先级
+' ========================================
+Option Explicit
+
+' ========================================
+' IsMatch 方法
+' 功能: 判断条件表达式是否匹配
+' 参数:
+' conditionExpr - 条件表达式字符串
+' conditions - Dictionary对象，包含变量名->值的映射
+' 返回: Boolean - 是否匹配
+' 示例:
+' IsMatch("lcfw=M16 AND gclj=M20", conditions) -> True/False
+' ========================================
+Public Function IsMatch(conditionExpr As String, conditions As Object) As Boolean
+ On Error GoTo ErrorHandler
+
+ ' 空条件表示无条件，始终匹配
+ If Trim(conditionExpr) = "" Then
+ IsMatch = True
+ Exit Function
+ End If
+
+ ' 解析并计算表达式
+ IsMatch = EvaluateExpression(Trim(conditionExpr), conditions)
+ Exit Function
+
+ErrorHandler:
+ ' 出错时返回False（保守处理）
+ Debug.Print "条件匹配出错: " & conditionExpr & " - " & Err.description
+ IsMatch = False
+End Function
+
+' ========================================
+' EvaluateExpression 方法 (私有)
+' 功能: 递归计算逻辑表达式
+' 优先级: 括号 > NOT(!=) > AND > OR
+' ========================================
+Private Function EvaluateExpression(expr As String, conditions As Object) As Boolean
+ expr = Trim(expr)
+
+ ' 处理括号 (最高优先级)
+ If InStr(expr, "(") > 0 Then
+ EvaluateExpression = EvaluateWithParentheses(expr, conditions)
+ Exit Function
+ End If
+
+ ' 处理 OR (最低优先级)
+ If InStr(expr, " OR ") > 0 Then
+ EvaluateExpression = EvaluateOR(expr, conditions)
+ Exit Function
+ End If
+
+ ' 处理 AND (中等优先级)
+ If InStr(expr, " AND ") > 0 Then
+ EvaluateExpression = EvaluateAND(expr, conditions)
+ Exit Function
+ End If
+
+ ' 处理单个条件 (最高优先级)
+ EvaluateExpression = EvaluateSimpleCondition(expr, conditions)
+End Function
+
+' ========================================
+' EvaluateWithParentheses 方法 (私有)
+' 功能: 处理包含括号的表达式
+' 策略: 找到最内层括号，递归计算，然后替换为结果
+' ========================================
+Private Function EvaluateWithParentheses(expr As String, conditions As Object) As Boolean
+ Dim pos As Long, level As Long, startPos As Long
+ Dim i As Long
+ Dim innerExpr As String
+ Dim innerResult As Boolean
+ Dim newExpr As String
+
+ ' 查找最内层的括号对
+ startPos = 0
+ level = 0
+
+ For i = 1 To Len(expr)
+ If Mid(expr, i, 1) = "(" Then
+ If level = 0 Then startPos = i
+ level = level + 1
+ ElseIf Mid(expr, i, 1) = ")" Then
+ level = level - 1
+ If level = 0 And startPos > 0 Then
+ ' 找到一对括号
+ innerExpr = Mid(expr, startPos + 1, i - startPos - 1)
+ innerResult = EvaluateExpression(innerExpr, conditions)
+
+ ' 替换括号部分为结果
+ newExpr = Left(expr, startPos - 1) & _
+ IIf(innerResult, "TRUE", "FALSE") & _
+ Mid(expr, i + 1)
+
+ ' 递归处理剩余部分
+ EvaluateWithParentheses = EvaluateExpression(newExpr, conditions)
+ Exit Function
+ End If
+ End If
+ Next i
+
+ ' 如果没有找到有效括号，直接计算
+ EvaluateWithParentheses = EvaluateExpression(expr, conditions)
+End Function
+
+' ========================================
+' EvaluateOR 方法 (私有)
+' 功能: 处理 OR 逻辑运算
+' 规则: 任一为真则为真
+' ========================================
+Private Function EvaluateOR(expr As String, conditions As Object) As Boolean
+ Dim parts() As String
+ Dim part As Variant
+
+ ' 按 OR 分割
+ parts = Split(expr, " OR ")
+
+ ' 任一部分为真则返回真
+ For Each part In parts
+ If EvaluateExpression(Trim(CStr(part)), conditions) Then
+ EvaluateOR = True
+ Exit Function
+ End If
+ Next part
+
+ EvaluateOR = False
+End Function
+
+' ========================================
+' EvaluateAND 方法 (私有)
+' 功能: 处理 AND 逻辑运算
+' 规则: 全部为真才为真
+' ========================================
+Private Function EvaluateAND(expr As String, conditions As Object) As Boolean
+ Dim parts() As String
+ Dim part As Variant
+
+ ' 按 AND 分割
+ parts = Split(expr, " AND ")
+
+ ' 全部部分为真才返回真
+ For Each part In parts
+ If Not EvaluateExpression(Trim(CStr(part)), conditions) Then
+ EvaluateAND = False
+ Exit Function
+ End If
+ Next part
+
+ EvaluateAND = True
+End Function
+
+' ========================================
+' EvaluateSimpleCondition 方法 (私有)
+' 功能: 计算单个条件表达式
+' 支持: = (等于), != (不等于)
+' 格式: varName=value 或 varName!=value
+' ========================================
+Private Function EvaluateSimpleCondition(cond As String, conditions As Object) As Boolean
+ cond = Trim(cond)
+
+ ' 处理特殊值 TRUE/FALSE (括号计算的结果)
+ If UCase(cond) = "TRUE" Then
+ EvaluateSimpleCondition = True
+ Exit Function
+ ElseIf UCase(cond) = "FALSE" Then
+ EvaluateSimpleCondition = False
+ Exit Function
+ End If
+
+ Dim varName As String
+ Dim expectedValue As String
+ Dim actualValue As String
+ Dim isNotEqual As Boolean
+
+ ' 判断是 != 还是 =
+ If InStr(cond, "!=") > 0 Then
+ isNotEqual = True
+ Dim parts1() As String
+ parts1 = Split(cond, "!=")
+ If UBound(parts1) < 1 Then
+ EvaluateSimpleCondition = False
+ Exit Function
+ End If
+ varName = Trim(parts1(0))
+ expectedValue = Trim(parts1(1))
+ ElseIf InStr(cond, "=") > 0 Then
+ isNotEqual = False
+ Dim parts2() As String
+ parts2 = Split(cond, "=")
+ If UBound(parts2) < 1 Then
+ EvaluateSimpleCondition = False
+ Exit Function
+ End If
+ varName = Trim(parts2(0))
+ expectedValue = Trim(parts2(1))
+ Else
+ ' 无效的条件格式
+ EvaluateSimpleCondition = False
+ Exit Function
+ End If
+
+ ' 获取实际值
+ If conditions.Exists(varName) Then
+ actualValue = Trim(CStr(conditions(varName)))
+ Else
+ actualValue = ""
+ End If
+
+ ' 比较值 (不区分大小写)
+ Dim isEqual As Boolean
+ isEqual = (UCase(actualValue) = UCase(expectedValue))
+
+ ' 返回结果
+ If isNotEqual Then
+ EvaluateSimpleCondition = Not isEqual
+ Else
+ EvaluateSimpleCondition = isEqual
+ End If
+End Function
+
+' ========================================
+' TestExpression 方法
+' 功能: 测试表达式是否有效 (用于调试)
+' 参数: expr - 表达式字符串
+' 返回: String - "有效" 或 错误信息
+' ========================================
+Public Function TestExpression(expr As String) As String
+ On Error GoTo ErrorHandler
+
+ ' 创建测试条件
+ Dim testConditions As Object
+ Set testConditions = CreateObject("Scripting.Dictionary")
+ testConditions("gclj") = "M20"
+ testConditions("jycz") = "3"
+ testConditions("lcfw") = "M16"
+
+ ' 尝试计算
+ Dim result As Boolean
+ result = IsMatch(expr, testConditions)
+
+ TestExpression = "有效 (结果: " & IIf(result, "True", "False") & ")"
+ Exit Function
+
+ErrorHandler:
+ TestExpression = "无效: " & Err.description
+End Function
+```
+
+## ClassModules\clsMaterialItem.cls
+
+```
+' ========================================
+' 类模块: clsMaterialItem
+' 用途: 表示单个物料项
+' ========================================
+Option Explicit
+
+Public code As String ' 代号
+Public Name As String ' 名称
+Public Quantity As Double ' 数量
+Public Condition As String ' 选择条件
+Public Category As String ' 类别
+Public ParentCategory As String ' 上层类别
+```
+
+## ClassModules\clsModelParser.cls
+
+```
+' ========================================
+' 类模块: clsModelParser
+' 用途: 解析产品型号，提取各部分代码
+' 示例: YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3
+' ========================================
+Option Explicit
+
+' ========================================
+' 公共属性
+' ========================================
+Public RawModel As String ' 原始完整型号
+Public HeaderModel As String ' 表头型号部分
+Public DialModel As String ' 表盘型号部分
+Public AccessoryModel As String ' 附件型号部分
+Public FlangeModel As String ' 法兰隔膜型号部分
+
+' 表头各部分
+Public ModelType As String ' 型号 (如 YTHN)
+Public Diameter As String ' 公称外径 (如 100)
+Public InstallForm As String ' 安装形式 (如 A0)
+Public ShellForm As String ' 壳体形式 (如 532)
+Public ConnectionCode As String ' 过程连接&材质代码 (如 M203)
+Public RangeCode As String ' 量程范围代码 (如 M16)
+Public Characteristics As String ' 仪表特性 (如 Y3)
+
+' ========================================
+' 私有变量
+' ========================================
+Private m_IsValid As Boolean ' 解析是否成功
+Private m_ErrorMessage As String ' 错误信息
+
+' ========================================
+' ParseModel 方法
+' 功能: 解析产品型号字符串
+' 参数: modelStr - 完整的产品型号字符串
+' 返回: Boolean - 解析是否成功
+' 示例: parser.ParseModel("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3")
+' ========================================
+Public Function ParseModel(modelStr As String) As Boolean
+ On Error GoTo ErrorHandler
+
+ ' 初始化
+ m_IsValid = False
+ m_ErrorMessage = ""
+ RawModel = Trim(modelStr)
+
+ ' 验证输入
+ If RawModel = "" Then
+ m_ErrorMessage = "型号字符串为空"
+ ParseModel = False
+ Exit Function
+ End If
+
+ ' 第一步: 按 | 分割各部分
+ Dim parts() As String
+ parts = Split(RawModel, "|")
+
+ If UBound(parts) >= 0 Then HeaderModel = Trim(parts(0))
+ If UBound(parts) >= 1 Then DialModel = Trim(parts(1))
+ If UBound(parts) >= 2 Then AccessoryModel = Trim(parts(2))
+ If UBound(parts) >= 3 Then FlangeModel = Trim(parts(3))
+
+ ' 第二步: 解析表头部分 (必须存在)
+ If HeaderModel = "" Then
+ m_ErrorMessage = "表头型号为空"
+ ParseModel = False
+ Exit Function
+ End If
+
+ ' 解析表头
+ If Not ParseHeader(HeaderModel) Then
+ ParseModel = False
+ Exit Function
+ End If
+
+ m_IsValid = True
+ ParseModel = True
+ Exit Function
+
+ErrorHandler:
+ m_ErrorMessage = "解析出错: " & Err.description
+ m_IsValid = False
+ ParseModel = False
+End Function
+
+' ========================================
+' ParseHeader 方法 (私有)
+' 功能: 解析表头型号部分
+' 格式: [型号]-[公称外径].[安装形式].[壳体形式].[过程连接&材质].[量程范围].[仪表特性]
+' 示例: YTHN-100.A0.532.M203.M16.Y3
+' ========================================
+Private Function ParseHeader(headerStr As String) As Boolean
+ On Error GoTo ErrorHandler
+
+ ' 按 - 分割型号和参数部分
+ Dim mainParts() As String
+ mainParts = Split(headerStr, "-")
+
+ If UBound(mainParts) < 1 Then
+ m_ErrorMessage = "表头格式错误: 缺少 - 分隔符"
+ ParseHeader = False
+ Exit Function
+ End If
+
+ ' 提取型号
+ ModelType = Trim(mainParts(0))
+
+ ' 按 . 分割参数部分
+ Dim params() As String
+ params = Split(mainParts(1), ".")
+
+ ' 验证参数数量 (至少应该有5个部分)
+ If UBound(params) < 4 Then
+ m_ErrorMessage = "表头参数不足: 需要至少5个参数段"
+ ParseHeader = False
+ Exit Function
+ End If
+
+ ' 提取各参数
+ Diameter = Trim(params(0)) ' 公称外径
+ InstallForm = Trim(params(1)) ' 安装形式
+ ShellForm = Trim(params(2)) ' 壳体形式
+ ConnectionCode = Trim(params(3)) ' 过程连接&材质
+ RangeCode = Trim(params(4)) ' 量程范围
+
+ ' 仪表特性 (可选)
+ If UBound(params) >= 5 Then
+ Characteristics = Trim(params(5))
+ Else
+ Characteristics = ""
+ End If
+
+ ParseHeader = True
+ Exit Function
+
+ErrorHandler:
+ m_ErrorMessage = "解析表头出错: " & Err.description
+ ParseHeader = False
+End Function
+
+' ========================================
+' GetThreadCode 方法
+' 功能: 从过程连接代码中提取螺纹代码
+' 规则: 去掉最后一位数字
+' 示例: M203 -> M20
+' ========================================
+Public Function GetThreadCode() As String
+ If ConnectionCode = "" Then
+ GetThreadCode = ""
+ Exit Function
+ End If
+
+ ' 去掉最后一位字符 (假设最后一位是材质代码)
+ If Len(ConnectionCode) > 1 Then
+ GetThreadCode = Left(ConnectionCode, Len(ConnectionCode) - 1)
+ Else
+ GetThreadCode = ConnectionCode
+ End If
+End Function
+
+' ========================================
+' GetMaterialCode 方法
+' 功能: 从过程连接代码中提取材质代码
+' 规则: 取最后一位数字
+' 示例: M203 -> 3
+' ========================================
+Public Function GetMaterialCode() As String
+ If ConnectionCode = "" Then
+ GetMaterialCode = ""
+ Exit Function
+ End If
+
+ ' 取最后一位字符
+ GetMaterialCode = Right(ConnectionCode, 1)
+End Function
+
+' ========================================
+' GetRangeCode 方法
+' 功能: 获取量程代码
+' 规则: 直接返回
+' 示例: M16 -> M16
+' ========================================
+Public Function GetRangeCode() As String
+ GetRangeCode = RangeCode
+End Function
+
+' ========================================
+' IsValid 属性
+' 功能: 返回解析是否成功
+' ========================================
+Public Property Get IsValid() As Boolean
+ IsValid = m_IsValid
+End Property
+
+' ========================================
+' ErrorMessage 属性
+' 功能: 返回错误信息
+' ========================================
+Public Property Get ErrorMessage() As String
+ ErrorMessage = m_ErrorMessage
+End Property
+
+' ========================================
+' ToString 方法
+' 功能: 返回解析结果的字符串表示 (用于调试)
+' ========================================
+Public Function ToString() As String
+ Dim result As String
+ result = "【型号解析结果】" & vbCrLf
+ result = result & "原始型号: " & RawModel & vbCrLf
+ result = result & "表头型号: " & HeaderModel & vbCrLf
+ result = result & "表盘型号: " & DialModel & vbCrLf
+ result = result & vbCrLf
+ result = result & "【表头各部分】" & vbCrLf
+ result = result & " 型号: " & ModelType & vbCrLf
+ result = result & " 公称外径: " & Diameter & vbCrLf
+ result = result & " 安装形式: " & InstallForm & vbCrLf
+ result = result & " 壳体形式: " & ShellForm & vbCrLf
+ result = result & " 过程连接&材质: " & ConnectionCode & vbCrLf
+ result = result & " 量程范围: " & RangeCode & vbCrLf
+ result = result & " 仪表特性: " & Characteristics & vbCrLf
+ result = result & vbCrLf
+ result = result & "【提取代码】" & vbCrLf
+ result = result & " 螺纹代码: " & GetThreadCode() & vbCrLf
+ result = result & " 材质代码: " & GetMaterialCode() & vbCrLf
+ result = result & " 量程代码: " & GetRangeCode() & vbCrLf
+
+ ToString = result
+End Function
+```
+
+## Modules\modBOMProcessor.bas
+
+```
+' ========================================
+' 模块: modBOMTest
+' 用途: 测试和使用BOM数据结构
+' ========================================
+Option Explicit
+
+Sub TestBOMStructure()
+ ' 初始化BOM管理器
+ Dim bomMgr As New clsBOMManager
+
+ ' 加载数据(假设工作表名称)
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+
+ ' 加载数据
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 打印类别树结构到新工作表
+ Dim wsOutput As Worksheet
+ On Error Resume Next
+ Application.DisplayAlerts = False
+ ThisWorkbook.Worksheets("BOM结构").Delete
+ Application.DisplayAlerts = True
+ On Error GoTo 0
+
+ Set wsOutput = ThisWorkbook.Worksheets.Add
+ wsOutput.Name = "BOM结构"
+
+ 'bomMgr.PrintCategoryTree wsOutput
+
+ Dim cats As collection
+ Dim i As Integer
+ Set cats = bomMgr.GetRootCategories()
+ For i = 1 To cats.Count
+ Debug.Print cats(i).categoryName
+ Next i
+
+
+
+ MsgBox "BOM数据结构加载完成!" & vbCrLf & _
+ "请查看 'BOM结构' 工作表", vbInformation
+End Sub
+
+' 示例: 获取特定类别的物料
+Sub GetCategoryMaterials()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet, wsPlatform As Worksheet
+
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 获取"部件"类别的物料(使用父类别)
+ Dim materials As collection
+ Set materials = bomMgr.GetMaterialsForPicking("部件", True)
+
+ Debug.Print "部件类别物料数量(父类别): " & materials.Count
+
+ ' 获取"部件"类别的物料(使用子类别)
+ Set materials = bomMgr.GetMaterialsForPicking("部件", False)
+
+ Debug.Print "部件类别物料数量(子类别展开): " & materials.Count
+
+ ' 遍历物料
+ Dim mat As clsMaterialItem
+ For Each mat In materials
+ Debug.Print mat.code & " - " & mat.Name & _
+ " | 数量:" & mat.Quantity & _
+ " | 条件:" & mat.Condition
+ Next mat
+End Sub
+
+' 示例: 根据产品型号生成领料清单
+Sub GeneratePickingList()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet, wsPlatform As Worksheet
+
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 创建领料清单工作表
+ Dim wsPickList As Worksheet
+ On Error Resume Next
+ Application.DisplayAlerts = False
+ ThisWorkbook.Worksheets("领料清单").Delete
+ Application.DisplayAlerts = True
+ On Error GoTo 0
+
+ Set wsPickList = ThisWorkbook.Worksheets.Add
+ wsPickList.Name = "领料清单"
+
+ ' 写入表头
+ Dim row As Long
+ row = 1
+ wsPickList.Cells(row, 1).value = "代号"
+ wsPickList.Cells(row, 2).value = "名称"
+ wsPickList.Cells(row, 3).value = "类别"
+ wsPickList.Cells(row, 4).value = "数量"
+ wsPickList.Cells(row, 5).value = "选择条件"
+ wsPickList.Cells(row, 6).value = "领料方式"
+ row = row + 1
+
+ ' 遍历所有根类别
+ Dim rootCats As collection
+ Set rootCats = bomMgr.GetRootCategories
+
+ Dim cat As clsCategory
+ Dim materials As collection
+ Dim mat As clsMaterialItem
+ Dim i As Long, j As Long
+
+ For i = 1 To rootCats.Count
+ Set cat = rootCats(i)
+ ' 默认使用父类别物料
+ Set materials = bomMgr.GetMaterialsForPicking(cat.categoryName, True)
+
+ For j = 1 To materials.Count
+ Set mat = materials(j)
+ wsPickList.Cells(row, 1).value = mat.code
+ wsPickList.Cells(row, 2).value = mat.Name
+ wsPickList.Cells(row, 3).value = mat.Category
+ wsPickList.Cells(row, 4).value = mat.Quantity
+ wsPickList.Cells(row, 5).value = mat.Condition
+ wsPickList.Cells(row, 6).value = "父类别"
+ row = row + 1
+ Next j
+ Next i
+
+ ' 格式化表格
+ wsPickList.Range("A1:F1").Font.Bold = True
+ wsPickList.Columns("A:F").AutoFit
+
+ MsgBox "领料清单生成完成!", vbInformation
+End Sub
+
+' 示例: 查询特定物料信息
+Sub QueryMaterialInfo()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet, wsPlatform As Worksheet
+
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 查询特定类别
+ Dim cat As clsCategory
+ Set cat = bomMgr.GetCategory("部件")
+
+ If Not cat Is Nothing Then
+ Debug.Print "类别: " & cat.categoryName
+ Debug.Print "父类别: " & cat.ParentCategoryName
+ Debug.Print "物料数: " & cat.materials.Count
+ Debug.Print "子类别数: " & cat.SubCategories.Count
+ Debug.Print "是否叶子类别: " & cat.IsLeafCategory
+
+ ' 列出所有物料
+ Dim mat As clsMaterialItem
+ Dim i As Long
+ For i = 1 To cat.materials.Count
+ Set mat = cat.materials(i)
+ Debug.Print " - " & mat.code & ": " & mat.Name
+ Next i
+
+ ' 列出所有子类别
+ Dim subCat As clsCategory
+ Dim j As Long
+ For j = 1 To cat.SubCategories.Count
+ Set subCat = cat.SubCategories(j)
+ Debug.Print " 子类别: " & subCat.categoryName & _
+ " (物料数:" & subCat.materials.Count & ")"
+ Next j
+ End If
+End Sub
+```
+
+## Modules\modModelParserExamples.bas
+
+```
+' ========================================
+' 模块: modModelParserExamples
+' 用途: 型号解析与物料匹配的实际应用示例
+' ========================================
+Option Explicit
+
+' ========================================
+' 示例1: 根据型号生成完整的领料清单
+' ========================================
+Sub Example1_GeneratePickingListByModel()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ ' 加载配置
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 产品型号
+ Dim modelStr As String
+ modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
+
+ ' 创建领料清单工作表
+ Dim wsPickList As Worksheet
+ On Error Resume Next
+ Application.DisplayAlerts = False
+ ThisWorkbook.Worksheets("型号领料清单").Delete
+ Application.DisplayAlerts = True
+ On Error GoTo 0
+
+ Set wsPickList = ThisWorkbook.Worksheets.Add
+ wsPickList.Name = "型号领料清单"
+
+ ' 写入表头
+ Dim row As Long
+ row = 1
+ wsPickList.Cells(row, 1).value = "产品型号"
+ wsPickList.Cells(row, 2).value = modelStr
+ row = row + 1
+
+ ' 提取条件并显示
+ Dim conditions As Object
+ Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
+ wsPickList.Cells(row, 1).value = "提取条件"
+ Dim condStr As String
+ Dim key As Variant
+ For Each key In conditions.Keys
+ condStr = condStr & key & "=" & conditions(key) & "; "
+ Next key
+ wsPickList.Cells(row, 2).value = condStr
+ row = row + 2
+
+ ' 表头
+ wsPickList.Cells(row, 1).value = "类别"
+ wsPickList.Cells(row, 2).value = "代号"
+ wsPickList.Cells(row, 3).value = "名称"
+ wsPickList.Cells(row, 4).value = "数量"
+ wsPickList.Cells(row, 5).value = "选择条件"
+ wsPickList.Cells(row, 6).value = "匹配状态"
+ wsPickList.Range("A" & row & ":F" & row).Font.Bold = True
+ row = row + 1
+
+ ' 遍历所有根类别
+ Dim rootCats As collection
+ Set rootCats = bomMgr.GetRootCategories
+
+ Dim cat As clsCategory
+ Dim materials As collection
+ Dim mat As clsMaterialItem
+ Dim i As Long
+
+ For i = 1 To rootCats.Count
+ Set cat = rootCats(i)
+
+ ' 获取该类别符合条件的物料
+ Set materials = bomMgr.GetMaterialsByModel(modelStr, cat.categoryName)
+
+ ' 写入物料
+ Dim j As Long
+ For j = 1 To materials.Count
+ Set mat = materials(j)
+ ' 使用物料自己的Category属性，而不是外层循环的类别名称
+ ' 这样当GetMaterialsByModel降级到子类别查找时，能正确显示子类别名称
+ wsPickList.Cells(row, 1).value = mat.Category
+ wsPickList.Cells(row, 2).value = mat.code
+ wsPickList.Cells(row, 3).value = mat.Name
+ wsPickList.Cells(row, 4).value = mat.Quantity
+ wsPickList.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition)
+ wsPickList.Cells(row, 6).value = "✓"
+ row = row + 1
+ Next j
+ Next i
+
+ ' 格式化
+ wsPickList.Columns("A:F").AutoFit
+
+ MsgBox "领料清单生成完成！" & vbCrLf & _
+ "请查看工作表: 型号领料清单", vbInformation
+End Sub
+
+' ========================================
+' 示例2: 批量处理多个型号
+' ========================================
+Sub Example2_BatchProcessModels()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ ' 加载配置
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 型号列表
+ Dim models() As String
+ models = Split("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3," & _
+ "YTHN-100.A0.532.M203.M02.Y3|BP-095.2312.M02.PA3," & _
+ "YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", ",")
+
+ ' 创建汇总表
+ Dim wsReport As Worksheet
+ On Error Resume Next
+ Application.DisplayAlerts = False
+ ThisWorkbook.Worksheets("批量型号汇总").Delete
+ Application.DisplayAlerts = True
+ On Error GoTo 0
+
+ Set wsReport = ThisWorkbook.Worksheets.Add
+ wsReport.Name = "批量型号汇总"
+
+ ' 表头
+ Dim row As Long
+ row = 1
+ wsReport.Cells(row, 1).value = "型号"
+ wsReport.Cells(row, 2).value = "提取条件"
+ wsReport.Cells(row, 3).value = "匹配物料数"
+ wsReport.Cells(row, 4).value = "部件物料"
+ wsReport.Range("A1:D1").Font.Bold = True
+ row = row + 1
+
+ ' 处理每个型号
+ Dim modelStr As String
+ Dim i As Long
+
+ For i = LBound(models) To UBound(models)
+ modelStr = Trim(models(i))
+ If modelStr <> "" Then
+ ' 提取条件
+ Dim conditions As Object
+ Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
+
+ Dim condStr As String
+ condStr = ""
+ Dim key As Variant
+ For Each key In conditions.Keys
+ condStr = condStr & key & "=" & conditions(key) & "; "
+ Next key
+
+ ' 获取物料
+ Dim materials As collection
+ Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件")
+
+ ' 写入结果
+ wsReport.Cells(row, 1).value = modelStr
+ wsReport.Cells(row, 2).value = condStr
+ wsReport.Cells(row, 3).value = materials.Count
+
+ ' 列出部件物料
+ Dim matList As String
+ matList = ""
+ Dim mat As clsMaterialItem
+ For Each mat In materials
+ matList = matList & mat.code & "(" & mat.Name & "); "
+ Next mat
+ wsReport.Cells(row, 4).value = matList
+
+ row = row + 1
+ End If
+ Next i
+
+ ' 格式化
+ wsReport.Columns("A:D").AutoFit
+
+ MsgBox "批量处理完成！", vbInformation
+End Sub
+
+' ========================================
+' 示例3: 查询并显示某个型号的详细信息
+' ========================================
+Sub Example3_ShowModelDetails()
+ ' 弹出输入框
+ Dim modelStr As String
+ modelStr = InputBox("请输入产品型号:", "型号查询", _
+ "YTHN-100.A0.532.M203.M16.Y3")
+
+ If modelStr = "" Then Exit Sub
+
+ ' 解析型号
+ Dim parser As New clsModelParser
+ If Not parser.ParseModel(modelStr) Then
+ MsgBox "型号解析失败: " & parser.ErrorMessage, vbCritical
+ Exit Sub
+ End If
+
+ ' 提取条件
+ Dim extractor As New clsConditionExtractor
+ Dim conditions As Object
+ Set conditions = extractor.ExtractConditions(parser)
+
+ ' 显示详细信息
+ Dim msg As String
+ msg = "【型号解析结果】" & vbCrLf & vbCrLf
+ msg = msg & "原始型号: " & parser.RawModel & vbCrLf
+ msg = msg & "表头型号: " & parser.HeaderModel & vbCrLf
+ msg = msg & "表盘型号: " & parser.DialModel & vbCrLf & vbCrLf
+
+ msg = msg & "【表头各部分】" & vbCrLf
+ msg = msg & "型号: " & parser.ModelType & vbCrLf
+ msg = msg & "公称外径: " & parser.Diameter & vbCrLf
+ msg = msg & "安装形式: " & parser.InstallForm & vbCrLf
+ msg = msg & "壳体形式: " & parser.ShellForm & vbCrLf
+ msg = msg & "过程连接&材质: " & parser.ConnectionCode & vbCrLf
+ msg = msg & "量程范围: " & parser.RangeCode & vbCrLf
+ msg = msg & "仪表特性: " & parser.Characteristics & vbCrLf & vbCrLf
+
+ msg = msg & "【提取的物料选择条件】" & vbCrLf
+ Dim key As Variant
+ For Each key In conditions.Keys
+ msg = msg & key & " = " & conditions(key) & vbCrLf
+ Next key
+
+ MsgBox msg, vbInformation, "型号详细信息"
+End Sub
+
+' ========================================
+' 示例4: 对比两个型号的差异
+' ========================================
+Sub Example4_CompareModels()
+ Dim model1 As String, model2 As String
+
+ model1 = InputBox("请输入第一个型号:", "型号对比", _
+ "YTHN-100.A0.532.M203.M16.Y3")
+ If model1 = "" Then Exit Sub
+
+ model2 = InputBox("请输入第二个型号:", "型号对比", _
+ "YTHN-100.A0.532.M203.M02.Y3")
+ If model2 = "" Then Exit Sub
+
+ ' 解析两个型号
+ Dim parser1 As New clsModelParser
+ Dim parser2 As New clsModelParser
+ Dim extractor As New clsConditionExtractor
+
+ parser1.ParseModel model1
+ parser2.ParseModel model2
+
+ Dim cond1 As Object, cond2 As Object
+ Set cond1 = extractor.ExtractConditions(parser1)
+
+ Set extractor = New clsConditionExtractor
+ Set cond2 = extractor.ExtractConditions(parser2)
+
+ ' 对比
+ Dim msg As String
+ msg = "【型号对比】" & vbCrLf & vbCrLf
+ msg = msg & "型号1: " & model1 & vbCrLf
+ msg = msg & "型号2: " & model2 & vbCrLf & vbCrLf
+
+ msg = msg & "【条件差异】" & vbCrLf
+ Dim key As Variant
+ Dim allKeys As Object
+ Set allKeys = CreateObject("Scripting.Dictionary")
+
+ For Each key In cond1.Keys
+ allKeys(key) = True
+ Next key
+ For Each key In cond2.Keys
+ allKeys(key) = True
+ Next key
+
+ For Each key In allKeys.Keys
+ Dim val1 As String, val2 As String
+ val1 = ""
+ val2 = ""
+
+ If cond1.Exists(key) Then val1 = cond1(key)
+ If cond2.Exists(key) Then val2 = cond2(key)
+
+ If val1 <> val2 Then
+ msg = msg & key & ": " & val1 & " → " & val2 & " ?" & vbCrLf
+ Else
+ msg = msg & key & ": " & val1 & " ?" & vbCrLf
+ End If
+ Next key
+
+ MsgBox msg, vbInformation, "型号对比结果"
+End Sub
+
+' ========================================
+' 示例5: 验证物料选择条件的有效性
+' ========================================
+Sub Example5_ValidateMaterialConditions()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ ' 加载配置
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 创建验证结果表
+ Dim wsValidation As Worksheet
+ On Error Resume Next
+ Application.DisplayAlerts = False
+ ThisWorkbook.Worksheets("条件验证结果").Delete
+ Application.DisplayAlerts = True
+ On Error GoTo 0
+
+ Set wsValidation = ThisWorkbook.Worksheets.Add
+ wsValidation.Name = "条件验证结果"
+
+ ' 表头
+ Dim row As Long
+ row = 1
+ wsValidation.Cells(row, 1).value = "代号"
+ wsValidation.Cells(row, 2).value = "名称"
+ wsValidation.Cells(row, 3).value = "选择条件"
+ wsValidation.Cells(row, 4).value = "验证结果"
+ wsValidation.Range("A1:D1").Font.Bold = True
+ row = row + 1
+
+ ' 获取所有根类别
+ Dim rootCats As collection
+ Set rootCats = bomMgr.GetRootCategories
+
+ Dim cat As clsCategory
+ Dim materials As collection
+ Dim mat As clsMaterialItem
+ Dim matcher As New clsConditionMatcher
+ Dim i As Long
+
+ ' 遍历所有物料
+ For i = 1 To rootCats.Count
+ Set cat = rootCats(i)
+ Set materials = New collection
+
+ ' 收集该类别的所有物料
+ Dim j As Long
+ For j = 1 To cat.materials.Count
+ materials.Add cat.materials(j)
+ Next j
+
+ ' 验证每个物料的条件
+ For Each mat In materials
+ wsValidation.Cells(row, 1).value = mat.code
+ wsValidation.Cells(row, 2).value = mat.Name
+ wsValidation.Cells(row, 3).value = IIf(mat.Condition = "", "(无)", mat.Condition)
+
+ If mat.Condition = "" Then
+ wsValidation.Cells(row, 4).value = "? 无条件"
+ Else
+ Dim validResult As String
+ validResult = matcher.TestExpression(mat.Condition)
+ wsValidation.Cells(row, 4).value = validResult
+ End If
+
+ row = row + 1
+ Next mat
+ Next i
+
+ ' 格式化
+ wsValidation.Columns("A:D").AutoFit
+
+ MsgBox "条件验证完成！", vbInformation
+End Sub
+
+' ========================================
+' 示例6: 对比启用/禁用自动降级的效果
+' ========================================
+Sub Example6_CompareAutoFallback()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ ' 加载配置
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 产品型号（使用可能导致类别缺失的型号）
+ Dim modelStr As String
+ modelStr = "YTHN-100.A0.532.M203.M17.Y3|BP-095.2312.M16.PA3"
+
+ ' 创建对比结果表
+ Dim wsCompare As Worksheet
+ On Error Resume Next
+ Application.DisplayAlerts = False
+ ThisWorkbook.Worksheets("降级模式对比").Delete
+ Application.DisplayAlerts = True
+ On Error GoTo 0
+
+ Set wsCompare = ThisWorkbook.Worksheets.Add
+ wsCompare.Name = "降级模式对比"
+
+ ' 表头
+ Dim row As Long
+ row = 1
+ wsCompare.Cells(row, 1).value = "型号"
+ wsCompare.Cells(row, 2).value = modelStr
+ row = row + 2
+
+ ' 测试1: 启用自动降级
+ wsCompare.Cells(row, 1).value = "模式1: 启用自动降级 (autoFallback=True)"
+ wsCompare.Cells(row, 1).Font.Bold = True
+ row = row + 1
+
+ wsCompare.Cells(row, 1).value = "类别"
+ wsCompare.Cells(row, 2).value = "代号"
+ wsCompare.Cells(row, 3).value = "名称"
+ wsCompare.Cells(row, 4).value = "数量"
+ wsCompare.Cells(row, 5).value = "选择条件"
+ wsCompare.Range("A" & row & ":E" & row).Font.Bold = True
+ row = row + 1
+
+ Dim materials As collection
+ Dim mat As clsMaterialItem
+ Dim i As Long
+
+ ' 获取启用自动降级的物料
+ Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", True)
+
+ If materials.Count = 0 Then
+ wsCompare.Cells(row, 1).value = "(无物料)"
+ row = row + 1
+ Else
+ For i = 1 To materials.Count
+ Set mat = materials(i)
+ wsCompare.Cells(row, 1).value = mat.Category
+ wsCompare.Cells(row, 2).value = mat.code
+ wsCompare.Cells(row, 3).value = mat.Name
+ wsCompare.Cells(row, 4).value = mat.Quantity
+ wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition)
+ row = row + 1
+ Next i
+ End If
+
+ row = row + 1
+
+ ' 测试2: 禁用自动降级
+ wsCompare.Cells(row, 1).value = "模式2: 禁用自动降级 (autoFallback=False)"
+ wsCompare.Cells(row, 1).Font.Bold = True
+ row = row + 1
+
+ wsCompare.Cells(row, 1).value = "类别"
+ wsCompare.Cells(row, 2).value = "代号"
+ wsCompare.Cells(row, 3).value = "名称"
+ wsCompare.Cells(row, 4).value = "数量"
+ wsCompare.Cells(row, 5).value = "选择条件"
+ wsCompare.Range("A" & row & ":E" & row).Font.Bold = True
+ row = row + 1
+
+ ' 获取禁用自动降级的物料
+ Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", False)
+
+ If materials.Count = 0 Then
+ wsCompare.Cells(row, 1).value = "(无物料 - 因为禁用降级)"
+ wsCompare.Cells(row, 2).value = "说明"
+ wsCompare.Cells(row, 3).value = "当父类别无匹配物料时,不会降级到子类别查找"
+ row = row + 1
+ Else
+ For i = 1 To materials.Count
+ Set mat = materials(i)
+ wsCompare.Cells(row, 1).value = mat.Category
+ wsCompare.Cells(row, 2).value = mat.code
+ wsCompare.Cells(row, 3).value = mat.Name
+ wsCompare.Cells(row, 4).value = mat.Quantity
+ wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition)
+ row = row + 1
+ Next i
+ End If
+
+ ' 添加说明
+ row = row + 1
+ wsCompare.Cells(row, 1).value = "说明:"
+ wsCompare.Cells(row, 1).Font.Bold = True
+ row = row + 1
+ wsCompare.Cells(row, 1).value = "• autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找"
+ row = row + 1
+ wsCompare.Cells(row, 1).value = "• autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合"
+
+ ' 格式化
+ wsCompare.Columns("A:E").AutoFit
+ wsCompare.Range("A1").Font.Bold = True
+
+ MsgBox "降级模式对比完成！" & vbCrLf & _
+ "请查看工作表: 降级模式对比" & vbCrLf & vbCrLf & _
+ "启用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", True).Count & " 个物料" & vbCrLf & _
+ "禁用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", False).Count & " 个物料", _
+ vbInformation
+End Sub
+
+' ========================================
+' 示例7: 测试GetValidMaterialsByModel方法
+' ========================================
+Sub Example7_TestGetValidMaterialsByModel()
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ ' 加载配置
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 创建测试结果工作表
+ Dim wsTest As Worksheet
+ On Error Resume Next
+ Application.DisplayAlerts = False
+ ThisWorkbook.Worksheets("物料完整性测试").Delete
+ Application.DisplayAlerts = True
+ On Error GoTo 0
+
+ Set wsTest = ThisWorkbook.Worksheets.Add
+ wsTest.Name = "物料完整性测试"
+
+ ' 写入标题
+ Dim row As Long
+ row = 1
+ wsTest.Cells(row, 1).value = "物料完整性测试报告"
+ wsTest.Cells(row, 1).Font.Bold = True
+ wsTest.Cells(row, 1).Font.Size = 14
+ row = row + 2
+
+ ' 测试多个型号
+ Dim testModels() As Variant
+ testModels = Array( _
+ Array("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3", "完整型号测试1"), _
+ Array("YTHN-100.A0.532.M203.M02.Y3|BP-095.2312.M02.PA3", "完整型号测试2"), _
+ Array("YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", "完整型号测试3"), _
+ Array("YTHN-100.A0.532.M203.M17.Y3", "可能不完整的型号") _
+ )
+
+ Dim i As Long
+ For i = LBound(testModels) To UBound(testModels)
+ Dim modelStr As String
+ Dim testName As String
+ modelStr = testModels(i)(0)
+ testName = testModels(i)(1)
+
+ ' 调用GetValidMaterialsByModel
+ Dim result As collection
+ Set result = bomMgr.GetValidMaterialsByModel(modelStr)
+
+ Dim materials As collection
+ Dim isComplete As Boolean
+ Set materials = result("Materials")
+ isComplete = result("IsComplete")
+
+ ' 写入测试名称和型号
+ wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName
+ wsTest.Cells(row, 1).Font.Bold = True
+ row = row + 1
+
+ wsTest.Cells(row, 1).value = "型号:"
+ wsTest.Cells(row, 2).value = modelStr
+ row = row + 1
+
+ wsTest.Cells(row, 1).value = "完整性:"
+ wsTest.Cells(row, 2).value = IIf(isComplete, "?? 完整", "?? 不完整")
+ If isComplete Then
+ wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0) ' 绿色
+ Else
+ wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0) ' 红色
+ End If
+ wsTest.Cells(row, 2).Font.Bold = True
+ row = row + 1
+
+ wsTest.Cells(row, 1).value = "物料数量:"
+ wsTest.Cells(row, 2).value = materials.count
+ row = row + 1
+
+ ' 写入物料明细表头
+ wsTest.Cells(row, 1).value = "类别"
+ wsTest.Cells(row, 2).value = "代号"
+ wsTest.Cells(row, 3).value = "名称"
+ wsTest.Cells(row, 4).value = "数量"
+ wsTest.Cells(row, 5).value = "选择条件"
+ wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Font.Bold = True
+ wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Interior.Color = RGB(200, 200, 200)
+ row = row + 1
+
+ ' 写入每个物料
+ Dim mat As clsMaterialItem
+ Dim j As Long
+ For j = 1 To materials.count
+ Set mat = materials(j)
+ wsTest.Cells(row, 1).value = mat.Category
+ wsTest.Cells(row, 2).value = mat.code
+ wsTest.Cells(row, 3).value = mat.Name
+ wsTest.Cells(row, 4).value = mat.Quantity
+ wsTest.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition)
+ row = row + 1
+ Next j
+
+ ' 添加分隔行
+ row = row + 1
+ wsTest.Cells(row, 1).value = String(80, "-")
+ row = row + 2
+ Next i
+
+ ' 添加统计汇总
+ wsTest.Cells(row, 1).value = "测试汇总"
+ wsTest.Cells(row, 1).Font.Bold = True
+ wsTest.Cells(row, 1).Font.Size = 12
+ row = row + 1
+
+ Dim completeCount As Long
+ Dim incompleteCount As Long
+ completeCount = 0
+ incompleteCount = 0
+
+ For i = LBound(testModels) To UBound(testModels)
+ modelStr = testModels(i)(0)
+ Set result = bomMgr.GetValidMaterialsByModel(modelStr)
+ If result("IsComplete") Then
+ completeCount = completeCount + 1
+ Else
+ incompleteCount = incompleteCount + 1
+ End If
+ Next i
+
+ wsTest.Cells(row, 1).value = "总测试数:"
+ wsTest.Cells(row, 2).value = UBound(testModels) - LBound(testModels) + 1
+ row = row + 1
+
+ wsTest.Cells(row, 1).value = "完整:"
+ wsTest.Cells(row, 2).value = completeCount
+ wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
+ row = row + 1
+
+ wsTest.Cells(row, 1).value = "不完整:"
+ wsTest.Cells(row, 2).value = incompleteCount
+ wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
+
+ ' 格式化
+ wsTest.Columns("A:E").AutoFit
+
+ MsgBox "物料完整性测试完成！" & vbCrLf & _
+ "完整: " & completeCount & " 个" & vbCrLf & _
+ "不完整: " & incompleteCount & " 个" & vbCrLf & vbCrLf & _
+ "请查看工作表: 物料完整性测试", vbInformation
+End Sub
+```
+
+## Modules\modModelParserTest.bas
+
+```
+' ========================================
+' 模块: modModelParserTest
+' 用途: 测试型号解析和物料匹配功能
+' ========================================
+Option Explicit
+
+' ========================================
+' 测试1: 型号解析器基础功能
+' ========================================
+Sub Test1_ModelParser()
+ Debug.Print String(80, "=")
+ Debug.Print "测试1: 型号解析器基础功能"
+ Debug.Print String(80, "=")
+
+ Dim parser As New clsModelParser
+ Dim modelStr As String
+
+ ' 测试用例1: 完整型号
+ modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
+ Debug.Print "【测试用例1】完整型号"
+ Debug.Print "输入: " & modelStr
+
+ If parser.ParseModel(modelStr) Then
+ Debug.Print parser.ToString()
+ Debug.Print "? 解析成功"
+ Else
+ Debug.Print "? 解析失败: " & parser.ErrorMessage
+ End If
+
+ Debug.Print ""
+
+ ' 测试用例2: 仅表头
+ modelStr = "YTHN-100.A0.532.M203.M16.Y3"
+ Debug.Print "【测试用例2】仅表头"
+ Debug.Print "输入: " & modelStr
+
+ If parser.ParseModel(modelStr) Then
+ Debug.Print " 螺纹代码: " & parser.GetThreadCode()
+ Debug.Print " 材质代码: " & parser.GetMaterialCode()
+ Debug.Print " 量程代码: " & parser.GetRangeCode()
+ Debug.Print "? 解析成功"
+ Else
+ Debug.Print "? 解析失败: " & parser.ErrorMessage
+ End If
+
+ Debug.Print String(80, "=")
+ Debug.Print ""
+End Sub
+
+' ========================================
+' 测试2: 条件提取器
+' ========================================
+Sub Test2_ConditionExtractor()
+ Debug.Print String(80, "=")
+ Debug.Print "测试2: 条件提取器"
+ Debug.Print String(80, "=")
+
+ Dim parser As New clsModelParser
+ Dim extractor As New clsConditionExtractor
+ Dim modelStr As String
+
+ modelStr = "YTHN-100.A0.532.M203.M16.Y3"
+ Debug.Print "输入型号: " & modelStr
+
+ If parser.ParseModel(modelStr) Then
+ Dim conditions As Object
+ Set conditions = extractor.ExtractConditions(parser)
+
+ Debug.Print extractor.ToString()
+
+ ' 验证提取结果
+ Debug.Print "【验证】"
+ Debug.Print " gclj = " & extractor.GetConditionValue("gclj") & _
+ IIf(extractor.GetConditionValue("gclj") = "M20", " ?", " ?")
+ Debug.Print " jycz = " & extractor.GetConditionValue("jycz") & _
+ IIf(extractor.GetConditionValue("jycz") = "3", " ?", " ?")
+ Debug.Print " lcfw = " & extractor.GetConditionValue("lcfw") & _
+ IIf(extractor.GetConditionValue("lcfw") = "M16", " ?", " ?")
+ Else
+ Debug.Print "? 型号解析失败"
+ End If
+
+ Debug.Print String(80, "=")
+ Debug.Print ""
+End Sub
+
+' ========================================
+' 测试3: 条件匹配器
+' ========================================
+Sub Test3_ConditionMatcher()
+ Debug.Print String(80, "=")
+ Debug.Print "测试3: 条件匹配器"
+ Debug.Print String(80, "=")
+
+ Dim matcher As New clsConditionMatcher
+ Dim conditions As Object
+ Set conditions = CreateObject("Scripting.Dictionary")
+ conditions("gclj") = "M20"
+ conditions("jycz") = "3"
+ conditions("lcfw") = "M16"
+
+ Debug.Print "【测试条件】"
+ Debug.Print " gclj = M20"
+ Debug.Print " jycz = 3"
+ Debug.Print " lcfw = M16"
+ Debug.Print ""
+
+ ' 测试用例
+ Dim testCases As Variant
+ testCases = Array( _
+ Array("", True, "空条件"), _
+ Array("lcfw=M16", True, "简单等于"), _
+ Array("lcfw=M17", False, "简单不匹配"), _
+ Array("lcfw=M16 AND gclj=M20", True, "AND 全真"), _
+ Array("lcfw=M16 AND gclj=M10", False, "AND 一假"), _
+ Array("lcfw=M16 OR lcfw=M17", True, "OR 一真"), _
+ Array("lcfw=M15 OR lcfw=M17", False, "OR 全假"), _
+ Array("gclj!=M10", True, "不等于 真"), _
+ Array("gclj!=M20", False, "不等于 假"), _
+ Array("lcfw=M02 AND gclj!=M20", False, "复合条件1"), _
+ Array("lcfw=M16 AND gclj!=M10", True, "复合条件2"), _
+ Array("gclj=M20 AND (lcfw=M16 OR lcfw=M17)", True, "括号优先级1"), _
+ Array("gclj=M20 AND (lcfw=M15 OR lcfw=M17)", False, "括号优先级2") _
+ )
+
+ Dim i As Long
+ Dim testCase As Variant
+ Dim expr As String
+ Dim expected As Boolean
+ Dim actual As Boolean
+ Dim description As String
+ Dim passCount As Long
+ Dim failCount As Long
+
+ passCount = 0
+ failCount = 0
+
+ Debug.Print "【测试用例】"
+ For i = LBound(testCases) To UBound(testCases)
+ testCase = testCases(i)
+ expr = testCase(0)
+ expected = testCase(1)
+ description = testCase(2)
+
+ actual = matcher.IsMatch(expr, conditions)
+
+ If actual = expected Then
+ Debug.Print " ? " & description & ": " & IIf(expr = "", "(空)", expr)
+ passCount = passCount + 1
+ Else
+ Debug.Print " ? " & description & ": " & expr
+ Debug.Print " 预期: " & expected & ", 实际: " & actual
+ failCount = failCount + 1
+ End If
+ Next i
+
+ Debug.Print ""
+ Debug.Print "【统计】"
+ Debug.Print " 通过: " & passCount
+ Debug.Print " 失败: " & failCount
+
+ Debug.Print String(80, "=")
+ Debug.Print ""
+End Sub
+
+' ========================================
+' 测试4: 完整流程 - 根据型号获取物料
+' ========================================
+Sub Test4_GetMaterialsByModel()
+ Debug.Print String(80, "=")
+ Debug.Print "测试4: 根据型号获取物料（完整流程）"
+ Debug.Print String(80, "=")
+
+ ' 加载BOM数据
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ On Error Resume Next
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+ On Error GoTo 0
+
+ If wsConfig Is Nothing Or wsPlatform Is Nothing Then
+ Debug.Print "? 错误: 找不到必需的工作表"
+ Exit Sub
+ End If
+
+ bomMgr.LoadData wsConfig, wsPlatform
+ Debug.Print "? BOM数据加载完成"
+ Debug.Print ""
+
+ ' 测试型号
+ Dim modelStr As String
+ modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
+
+ ' 获取"部件"类别的符合条件的物料
+ Dim materials As collection
+ Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件")
+
+ Debug.Print ""
+ Debug.Print "【结果验证】"
+ If materials.Count = 1 Then
+ Dim mat As clsMaterialItem
+ Set mat = materials(1)
+ If mat.code = "01011019018" And mat.Name = "高压接头部件" Then
+ Debug.Print "? 测试通过！成功匹配到正确的物料"
+ Debug.Print " 代号: " & mat.code
+ Debug.Print " 名称: " & mat.Name
+ Debug.Print " 条件: " & mat.Condition
+ Else
+ Debug.Print "? 匹配到的物料不正确"
+ End If
+ Else
+ Debug.Print "? 匹配数量不正确，预期1个，实际" & materials.Count & "个"
+ End If
+
+ Debug.Print String(80, "=")
+ Debug.Print ""
+End Sub
+
+' ========================================
+' 测试5: 获取所有类别的符合条件的物料
+' ========================================
+Sub Test5_GetAllMaterialsByModel()
+ Debug.Print String(80, "=")
+ Debug.Print "测试5: 获取所有类别的符合条件的物料"
+ Debug.Print String(80, "=")
+
+ ' 加载BOM数据
+ Dim bomMgr As New clsBOMManager
+ Dim wsConfig As Worksheet
+ Dim wsPlatform As Worksheet
+
+ On Error Resume Next
+ Set wsConfig = ThisWorkbook.Worksheets("领料配置")
+ Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
+ On Error GoTo 0
+
+ If wsConfig Is Nothing Or wsPlatform Is Nothing Then
+ Debug.Print "? 错误: 找不到必需的工作表"
+ Exit Sub
+ End If
+
+ bomMgr.LoadData wsConfig, wsPlatform
+
+ ' 测试型号
+ Dim modelStr As String
+ modelStr = "YTHN-100.A0.532.M203.M16.Y3"
+
+ ' 获取所有类别的符合条件的物料
+ Dim materials As collection
+ Set materials = bomMgr.GetMaterialsByModel(modelStr)
+
+ Debug.Print ""
+ Debug.Print "【匹配结果汇总】"
+ Debug.Print " 共匹配 " & materials.Count & " 个物料"
+
+ Debug.Print String(80, "=")
+ Debug.Print ""
+End Sub
+
+' ========================================
+' 运行所有测试
+' ========================================
+Sub RunAllTests()
+ Debug.Print vbCrLf & vbCrLf
+ Debug.Print "╔" & String(78, "═") & "╗"
+ Debug.Print "║" & Space(20) & "型号解析与物料匹配 - 完整测试套件" & Space(20) & "║"
+ Debug.Print "╚" & String(78, "═") & "╝"
+ Debug.Print ""
+
+ Test1_ModelParser
+ Test2_ConditionExtractor
+ Test3_ConditionMatcher
+ Test4_GetMaterialsByModel
+ Test5_GetAllMaterialsByModel
+
+ Debug.Print "╔" & String(78, "═") & "╗"
+ Debug.Print "║" & Space(30) & "所有测试完成" & Space(30) & "║"
+ Debug.Print "╚" & String(78, "═") & "╝"
+End Sub
+
+' ========================================
+' 测试6: 条件提取规则展示
+' ========================================
+Sub Test6_ShowExtractionRules()
+ Debug.Print String(80, "=")
+ Debug.Print "测试6: 当前配置的条件提取规则"
+ Debug.Print String(80, "=")
+
+ Dim extractor As New clsConditionExtractor
+ Dim rules As Object
+ Set rules = extractor.GetExtractionRules()
+
+ Debug.Print "【提取规则配置】"
+ Dim key As Variant
+ For Each key In rules.Keys
+ Dim ruleInfo As Variant
+ ruleInfo = rules(key)
+ Debug.Print " 变量名: " & key
+ Debug.Print " 源字段: " & ruleInfo(0)
+ Debug.Print " 提取方法: " & ruleInfo(1)
+ Debug.Print ""
+ Next key
+
+ Debug.Print String(80, "=")
+ Debug.Print ""
+End Sub
+```