admin/AutoBOM
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

docs: expand AutoBOM architecture and implementation details

Browse Source 
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:
Misaka_Company
2026-01-20 13:42:03 +08:00
parent bc5ea92c52
commit a1347017e3
13 changed files with 2682 additions and 828 deletions
Download Patch File Download Diff File Expand all files Collapse all files

231
VBA/ClassModules/clsBOMManager.cls
View File

@@ -16,7 +16,7 @@ Private dictCategories As Object ' Dictionary对象: 类别名称 -> clsCateg
' 作用: 快速查找任意类别
Private dictAllMaterials As Object ' Dictionary对象: 物料代号 -> clsMaterialItem对象
' 作用: 快速查找任意物料
Private rootCategories As Collection ' Collection: 存储所有顶层类别(无父类别的类别)
Private rootCategories As collection ' Collection: 存储所有顶层类别(无父类别的类别)
' 作用: 遍历完整的类别树结构
' ========================================
@@ -26,7 +26,7 @@ Private rootCategories As Collection ' Collection: 存储所有顶层类别(无
Private Sub Class_Initialize()
Set dictCategories = CreateObject("Scripting.Dictionary")
Set dictAllMaterials = CreateObject("Scripting.Dictionary")
Set rootCategories = New Collection
Set rootCategories = New collection
End Sub
' ========================================
@@ -59,12 +59,12 @@ Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet)
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 & "") ' 物料名称
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) ' 物料数量
mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) ' 物料数量
On Error GoTo 0
mat.Condition = Trim(wsPlatform.Cells(i, "F").Value & "") ' 选择条件
mat.Condition = Trim(wsPlatform.Cells(i, "F").value & "") ' 选择条件
' 只保存代号非空的物料
If mat.code <> "" Then
@@ -86,9 +86,9 @@ Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet)
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 & "") ' 上层类别名称
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
@@ -155,7 +155,7 @@ End Sub
' Debug.Print cats(i).CategoryName
' Next i
' ========================================
Public Function GetRootCategories() As Collection
Public Function GetRootCategories() As collection
Set GetRootCategories = rootCategories
End Function
@@ -208,9 +208,9 @@ End Function
' ' 返回: 径向低压接头、弹簧管、螺旋管等零件
' ========================================
Public Function GetMaterialsForPicking(categoryName As String, _
Optional useParent As Boolean = True) As Collection
Dim result As Collection
Set result = New Collection
Optional useParent As Boolean = True) As collection
Dim result As collection
Set result = New collection
' 查找指定类别
Dim cat As clsCategory
@@ -232,8 +232,8 @@ Public Function GetMaterialsForPicking(categoryName As String, _
' - 这是正常情况下的领料方式(领取组装好的部件)
' ========================================
Dim m As clsMaterialItem
For i = 1 To cat.Materials.Count
Set m = cat.Materials(i)
For i = 1 To cat.materials.Count
Set m = cat.materials(i)
result.Add m
Next i
Else
@@ -253,7 +253,7 @@ Public Function GetMaterialsForPicking(categoryName As String, _
Dim j As Long
For j = 1 To cat.SubCategories.Count
Set subCat = cat.SubCategories(j)
Dim subMats As Collection
Dim subMats As collection
' 递归调用,继续展开子类别
Set subMats = GetMaterialsForPicking(subCat.categoryName, False)
Dim k As Long
@@ -263,8 +263,8 @@ Public Function GetMaterialsForPicking(categoryName As String, _
Next j
Else
' 叶子类别,返回本类别物料
For i = 1 To cat.Materials.Count
Set m = cat.Materials(i)
For i = 1 To cat.materials.Count
Set m = cat.materials(i)
result.Add m
Next i
End If
@@ -297,7 +297,7 @@ End Function
Public Sub PrintCategoryTree(ws As Worksheet)
Dim row As Long
row = 1
ws.Cells(row, 1).Value = "类别层级结构"
ws.Cells(row, 1).value = "类别层级结构"
row = row + 1
' 遍历所有根类别,递归打印整个树
@@ -329,19 +329,19 @@ Private Sub PrintCategory(ws As Worksheet, cat As clsCategory, _
indent = String(level * 2, " ")
' 打印类别名称和物料数量统计
ws.Cells(row, 1).Value = indent & cat.categoryName & _
" (物料数:" & cat.Materials.Count & ")"
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)
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
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
@@ -353,4 +353,181 @@ Private Sub PrintCategory(ws As Worksheet, cat As clsCategory, _
' 递归调用,层级加1
Call PrintCategory(ws, subCat, row, level + 1)
Next j
End Sub
End Sub
' ========================================
' GetMaterialsByModel 方法
' 功能: 根据产品型号获取符合条件的物料清单
' 参数:
' modelStr - 产品型号字符串
' categoryName - 可选，指定类别名称。为空则返回所有类别的物料
' 返回: Collection对象，包含符合条件的clsMaterialItem对象
' 示例:
' Set materials = bomMgr.GetMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3")
' Set materials = bomMgr.GetMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3", "部件")
' ========================================
Public Function GetMaterialsByModel(modelStr As String, _
Optional categoryName As String = "") 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
' 2. 提取条件
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 ""
' 3. 创建条件匹配器
Dim matcher As New clsConditionMatcher
' 4. 获取要筛选的物料范围
Dim materialsToFilter As collection
Set materialsToFilter = New collection
If categoryName <> "" Then
' 指定类别：获取该类别的所有物料
Dim cat As clsCategory
Set cat = GetCategory(categoryName)
If Not cat Is Nothing Then
Dim i As Long
For i = 1 To cat.materials.Count
materialsToFilter.Add cat.materials(i)
Next i
End If
Else
' 未指定类别：获取所有根类别的物料
Dim rootCat As clsCategory
Dim j As Long
For j = 1 To rootCategories.Count
Set rootCat = rootCategories(j)
' 递归获取所有物料
Call CollectAllMaterials(rootCat, materialsToFilter)
Next j
End If
' 5. 筛选符合条件的物料
Dim mat As clsMaterialItem
Dim matchCount As Long
matchCount = 0
For Each mat In materialsToFilter
' 使用条件匹配器判断
If matcher.IsMatch(mat.Condition, conditions) Then
result.Add mat
matchCount = matchCount + 1
' 调试输出
Debug.Print "【匹配】 " & mat.code & " - " & mat.Name & _
" | 条件: " & IIf(mat.Condition = "", "(无)", mat.Condition)
End If
Next mat
Debug.Print "共匹配 " & matchCount & " 个物料"
Debug.Print String(60, "=")
Set GetMaterialsByModel = 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