docs: expand AutoBOM architecture and implementation details
Refine project overview to include specific business context (Blaidy Company) and the main workbook file. Restructure the architecture section into a layered object-oriented design (Data, Processing, Application layers) and define the responsibilities of core VBA classes. Add new technical documentation sections covering: - Model number format parsing structure - Condition expression language syntax - Category hierarchy logic and picking strategies - Material matching pipeline flow Include VBA code examples for key methods such as CollectAllMaterials and GetMaterialsByCategoryAndModel to illustrate recursive traversal and material retrieval logic. Clarify the structure of key Excel configuration sheets.
This commit is contained in:
375
VBA/Modules/modModelParserExamples.bas
Normal file
375
VBA/Modules/modModelParserExamples.bas
Normal file
@@ -0,0 +1,375 @@
|
||||
' ========================================
|
||||
' 模块: 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)
|
||||
wsPickList.Cells(row, 1).value = cat.categoryName
|
||||
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
|
||||
Reference in New Issue
Block a user