388ccc4e7a
Refactored the material retrieval logic in GetMaterialsByModel to automatically search within subcategories if no matches are found in the specified parent category. - Added FilterCategoryWithSubcategories helper function to handle recursive searching and fallback logic. - Restructured main function to delegate filtering to the new helper. - Enhanced code comments to clarify the step-by-step matching process.
377 lines
12 KiB
QBasic
377 lines
12 KiB
QBasic
' ========================================
|
||
' 模块: 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 |