AutoBOM/VBA/combined_output.md

目录

• ClassModules\clsBOMManager.cls
• ClassModules\clsCategory.cls
• ClassModules\clsConditionExtractor.cls
• ClassModules\clsConditionMatcher.cls
• ClassModules\clsMaterialItem.cls
• ClassModules\clsModelParser.cls
• Modules\modBOMProcessor.bas
• Modules\modModelParserExamples.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