AutoBOM/VBA/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