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

refactor: remove debug output and update order logic

Browse Source 
- Commented out verbose Debug.Print statements in `GetMaterialsByModel` and `FilterCategoryWithSubcategories` to reduce console noise.
- Added validation checks to ensure required worksheets ('平台配置清单', '产品订单') exist before loading data.
- Refactored order processing logic to aggregate results into a Collection for structured output generation, including headers.
This commit is contained in:
Misaka_Company
2026-01-26 09:13:27 +08:00
parent 40a9fe99f4
commit 255bcdb5fe
10 changed files with 474 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

82
VBA/ClassModules/clsBOMManager.cls
View File

@@ -424,7 +424,7 @@ Public Function GetMaterialsByModel(modelStr As String, _
' ========================================
Dim parser As New clsModelParser
If Not parser.ParseModel(modelStr) Then
Debug.Print "型号解析失败: " & parser.ErrorMessage
'Debug.Print "型号解析失败: " & parser.ErrorMessage
Set GetMaterialsByModel = result
Exit Function
End If
@@ -434,13 +434,13 @@ Public Function GetMaterialsByModel(modelStr As String, _
Set conditions = extractor.ExtractConditions(parser)
' 调试输出
Debug.Print "【型号】: " & modelStr
Debug.Print "【提取的条件】:"
'Debug.Print "【型号】: " & modelStr
'Debug.Print "【提取的条件】:"
Dim key As Variant
For Each key In conditions.Keys
Debug.Print " " & key & " = " & conditions(key)
'Debug.Print " " & key & " = " & conditions(key)
Next key
Debug.Print ""
'Debug.Print ""
' ========================================
' 第2步: 按类别筛选物料（根据参数决定是否自动降级到子类别）
@@ -454,11 +454,11 @@ Public Function GetMaterialsByModel(modelStr As String, _
totalMatchCount = 0
If autoFallback Then
Debug.Print "【降级模式】启用自动降级到子类别"
'Debug.Print "【降级模式】启用自动降级到子类别"
Else
Debug.Print "【降级模式】禁用自动降级，仅查找当前类别"
'Debug.Print "【降级模式】禁用自动降级，仅查找当前类别"
End If
Debug.Print ""
'Debug.Print ""
If categoryName <> "" Then
' ========================================
@@ -496,8 +496,8 @@ Public Function GetMaterialsByModel(modelStr As String, _
Next j
End If
Debug.Print "共匹配 " & totalMatchCount & " 个物料"
Debug.Print String(60, "=")
'Debug.Print "共匹配 " & totalMatchCount & " 个物料"
'Debug.Print String(60, "=")
Set GetMaterialsByModel = result
End Function
@@ -557,7 +557,7 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _
matchCount = matchCount + 1
' 调试输出
Debug.Print "【匹配】" & cat.categoryName & " > " & _
'Debug.Print "【匹配】" & cat.categoryName & " > " & _
mat.code & " - " & mat.Name & _
" | 条件: " & IIf(mat.Condition = "", "(无)", mat.Condition)
End If
@@ -567,7 +567,7 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _
' 第二阶段: 如果当前类别无匹配且允许降级，检查子类别
' ========================================
If matchCount = 0 And cat.HasSubCategories And autoFallback Then
Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..."
'Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..."
' 递归处理所有子类别
Dim subCat As clsCategory
@@ -586,9 +586,9 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _
Next k
Next j
ElseIf matchCount = 0 And cat.HasSubCategories And Not autoFallback Then
Debug.Print "【跳过】类别 """ & cat.categoryName & """ 无匹配物料，但降级已禁用，不查找子类别"
'Debug.Print "【跳过】类别 """ & cat.categoryName & """ 无匹配物料，但降级已禁用，不查找子类别"
ElseIf matchCount > 0 Then
Debug.Print "【成功】类别 """ & cat.categoryName & """ 匹配 " & matchCount & " 个物料"
'Debug.Print "【成功】类别 """ & cat.categoryName & """ 匹配 " & matchCount & " 个物料"
End If
Set FilterCategoryWithSubcategories = result
@@ -712,7 +712,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim allMaterials As New collection
Dim allMissingCats As New collection ' 用于存储所有缺失的类别
Dim isComplete As Boolean
' 解析型号并提取条件
Dim parser As New clsModelParser
If Not parser.ParseModel(modelStr) Then
@@ -724,26 +724,26 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
Set GetValidMaterialsByModel = result
Exit Function
End If
Dim extractor As New clsConditionExtractor
Dim conditions As Object
Set conditions = extractor.ExtractConditions(parser)
' 条件匹配器
Dim matcher As New clsConditionMatcher
' 遍历所有根类别,检查完整性
isComplete = True
Dim rootCat As clsCategory
Dim i As Long
For i = 1 To rootCategories.count
For i = 1 To rootCategories.Count
Set rootCat = rootCategories(i)
' 检查该类别及其子类别的完整性
Dim catResult As Object
Set catResult = CheckCategoryCompleteness(rootCat, matcher, conditions)
' 1. 合并匹配到的物料
Dim mat As clsMaterialItem
Dim matCollection As collection
@@ -751,7 +751,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
For Each mat In matCollection
allMaterials.Add mat
Next mat
' 2. 合并缺失的类别 (新增)
Dim missingCollection As collection
Set missingCollection = catResult("Missing")
@@ -759,18 +759,18 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
For Each missingCatName In missingCollection
allMissingCats.Add missingCatName
Next missingCatName
' 3. 检查完整性状态
If Not catResult("IsComplete") Then
isComplete = False
End If
Next i
' 返回结果
result.Add allMaterials, "Materials"
result.Add isComplete, "IsComplete"
result.Add allMissingCats, "MissingCategories" ' 新增返回项
Set GetValidMaterialsByModel = result
End Function
@@ -803,25 +803,25 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
conditions As Object) As Object
Dim result As Object
Set result = CreateObject("Scripting.Dictionary")
Dim materials As New collection
Dim missingCats As New collection ' 本层级及子层级缺失的类别
Dim isComplete As Boolean
' 首先在当前类别查找匹配的物料
Dim mat As clsMaterialItem
Dim matchCount As Long
matchCount = 0
Dim i As Long
For i = 1 To cat.materials.count
For i = 1 To cat.materials.Count
Set mat = cat.materials(i)
If matcher.IsMatch(mat.Condition, conditions) Then
materials.Add mat
matchCount = matchCount + 1
End If
Next i
' 判断完整性
If Not cat.HasSubCategories Then
' ========================================
@@ -847,28 +847,28 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
' 不需要检查子类别了，missingCats 保持为空
ElseIf matchCount = 0 Then
' 父类别无匹配物料, 必须降级检查所有子类别
' 清空当前物料集合(确保没东西), 准备收集子类别结果
Set materials = New collection
isComplete = True ' 先假设完整, 若任一子类别不完整则置错
Dim subCat As clsCategory
Dim j As Long
For j = 1 To cat.SubCategories.count
For j = 1 To cat.SubCategories.Count
Set subCat = cat.SubCategories(j)
' 递归检查子类别
Dim subResult As Object
Set subResult = CheckCategoryCompleteness(subCat, matcher, conditions)
' a) 合并子类别物料
Dim subMaterials As collection
Set subMaterials = subResult("Materials")
Dim k As Long
For k = 1 To subMaterials.count
For k = 1 To subMaterials.Count
materials.Add subMaterials(k)
Next k
' b) 合并子类别缺失列表 (关键步骤)
Dim subMissing As collection
Set subMissing = subResult("Missing")
@@ -876,7 +876,7 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
For Each item In subMissing
missingCats.Add item
Next item
' c) 更新完整性状态
If Not subResult("IsComplete") Then
isComplete = False
@@ -887,10 +887,10 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
isComplete = False
End If
End If
' 封装返回结果
Set result("Materials") = materials
result("IsComplete") = isComplete
Set result("Missing") = missingCats
Set CheckCategoryCompleteness = result
End Function
End Function

34
VBA/ClassModules/clsMaterialWithFlag.cls Normal file
View File

@@ -0,0 +1,34 @@
' ========================================
' 类模块: clsMaterialWithFlag
' 用途: 包装物料对象及其匹配状态标志
' ========================================
Option Explicit
Private mMaterial As clsMaterialItem ' 物料对象
Private mIsComplete As Boolean ' 是否完整匹配
' ========================================
' 属性: Material
' 说明: 获取或设置物料对象
' ========================================
Public Property Get Material() As clsMaterialItem
Set Material = mMaterial
End Property
Public Property Set Material(ByVal value As clsMaterialItem)
Set mMaterial = value
End Property
' ========================================
' 属性: IsComplete
' 说明: 获取或设置是否完整匹配
' True: 该物料属于完整的物料清单
' False: 该物料属于不完整的物料清单（某些类别缺失物料）
' ========================================
Public Property Get isComplete() As Boolean
isComplete = mIsComplete
End Property
Public Property Let isComplete(ByVal value As Boolean)
mIsComplete = value
End Property