Changes:
1. Update all modules to use LoadData(wsPlatform) instead of LoadData(wsConfig, wsPlatform)
- modModelParserExamples.bas: Update 7 example procedures
- modBOMProcessor.bas: Update 4 procedures
- modModelParserTest.bas: Update 2 test procedures
2. Fix completeness check logic in GetValidMaterialsByModel
- Only check root categories to avoid duplicate checking of subcategories
- Previously, all required categories (including subcategories) were checked,
causing subcategories to be added to missing list multiple times
- Now only checks categories with ParentCategoryName = ""
- CheckCategoryCompleteness already recursively checks all subcategories
3. Improve completeness judgment logic for categories with subcategories
- Method 1: Parent category has 1 matching material → Complete
- Method 2: Parent category has 0 matching materials, but all subcategories are complete → Complete
- Other cases → Incomplete
Impact:
- Fixes "category missing" errors in Example9_BatchProcessOrders_WithCheck
- Eliminates duplicate entries in missing categories list
- Properly handles category hierarchy where parent categories are satisfied through subcategories
Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
307 lines
9.5 KiB
QBasic
307 lines
9.5 KiB
QBasic
' ========================================
|
||
' 模块: 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 wsPlatform As Worksheet
|
||
|
||
On Error Resume Next
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
On Error GoTo 0
|
||
|
||
If wsPlatform Is Nothing Then
|
||
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
|
||
Exit Sub
|
||
End If
|
||
|
||
' ⭐ 使用新接口
|
||
bomMgr.LoadData 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 wsPlatform As Worksheet
|
||
|
||
On Error Resume Next
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
On Error GoTo 0
|
||
|
||
If wsPlatform Is Nothing Then
|
||
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
|
||
Exit Sub
|
||
End If
|
||
|
||
' ⭐ 使用新接口
|
||
bomMgr.LoadData 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 |