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

refactor: implement two-phase BOM matching error validation with warning support
All checks were successful
NTFY Notification / notify (push) Successful in 4s
Details

Browse Source 
Major refactoring of BOM matching error handling mechanism to separate
matching phase from validation phase, enabling cross-worksheet validation
and non-blocking warnings.

Changes:
- clsErrorLogger: Add warning support
  - Add RecordWarning() method for non-blocking issues
  - Add HasWarnings and HasIssues properties
  - Update PrintReport() to show errors and warnings with color coding
  - Add "Type" column to distinguish errors from warnings

- M09_BOMExtractor: Implement two-phase validation
  - Replace MatchAllMaterialTypes() with MatchAllMaterialTypesWithValidation()
  - Add ValidateAllMatchResults() for unified cross-worksheet validation
  - Phase 1 (Collection): Gather all worksheet matches without recording errors
  - Phase 2 (Validation): Validate all results with special rules for components
  - Phase 3 (Generation): Create final material collection based on validation
  - Add ToArray() helper for Collection to Array conversion

- Enhanced component/joint/element validation:
  - Support warnings for non-blocking conflicts (e.g., component + joint both matched)
  - Better cross-validation between "部件", "接头", "弹性元件" worksheets
  - Distinguish between errors (blocking) and warnings (non-blocking)

- Documentation updates:
  - Update BOM匹配错误判断机制详解.md to v2.0
  - Document two-phase verification approach
  - Add warning scenarios and handling

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-02-12 15:36:23 +08:00
parent 68798920d6
commit 8271958adf
3 changed files with 1701 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
VBA_BOMConverter/ClassModules/clsErrorLogger.cls
View File

@@ -5,9 +5,11 @@
Option Explicit
Private pErrors As Collection
Private pWarnings As Collection
Private Sub Class_Initialize()
Set pErrors = New Collection
Set pWarnings = New Collection
End Sub
' 记录错误
@@ -21,35 +23,83 @@ Public Property Get HasErrors() As Boolean
HasErrors = (pErrors.count > 0)
End Property
' 是否有警告
Public Property Get HasWarnings() As Boolean
HasWarnings = (pWarnings.count > 0)
End Property
' 是否有问题（错误或警告）
Public Property Get HasIssues() As Boolean
HasIssues = (pErrors.count > 0 Or pWarnings.count > 0)
End Property
' 记录警告
Public Sub RecordWarning(RowIndex As Long, SourceFunc As String, WarningType As String, Desc As String, Context As String)
pWarnings.Add Array(RowIndex, SourceFunc, WarningType, Desc, Context)
End Sub
' 输出报告到新工作表
Public Sub PrintReport(targetWb As Workbook)
If pErrors.count = 0 Then Exit Sub
If pErrors.count = 0 And pWarnings.count = 0 Then Exit Sub
Dim ws As Worksheet
Set ws = targetWb.Worksheets.Add(After:=targetWb.Worksheets(targetWb.Worksheets.count))
ws.Name = "错误报告_" & Format(Now, "hhmmss")
' 表头
ws.Range("A1:E1").Value = Array("原表行号", "来源模块", "错误类型", "详细描述", "原始数据")
ws.Range("A1:E1").Font.Bold = True
ws.Range("A1:E1").Interior.Color = RGB(255, 200, 200)
' 表头 (增加"类型"列)
ws.Range("A1:F1").Value = Array("类型", "原表行号", "来源模块", "错误类型", "详细描述", "原始数据")
ws.Range("A1:F1").Font.Bold = True
ws.Range("A1:F1").Interior.Color = RGB(217, 217, 217)
' 准备输出数组
Dim totalIssues As Long
totalIssues = pErrors.count + pWarnings.count
Dim arrOutput() As Variant
ReDim arrOutput(1 To pErrors.count, 1 To 5)
ReDim arrOutput(1 To totalIssues, 1 To 6)
Dim i As Long
Dim vItem As Variant
' 先输出错误
For i = 1 To pErrors.count
vItem = pErrors(i)
arrOutput(i, 1) = vItem(0)
arrOutput(i, 2) = vItem(1)
arrOutput(i, 3) = vItem(2)
arrOutput(i, 4) = vItem(3)
arrOutput(i, 5) = vItem(4)
arrOutput(i, 1) = "错误"
arrOutput(i, 2) = vItem(0)
arrOutput(i, 3) = vItem(1)
arrOutput(i, 4) = vItem(2)
arrOutput(i, 5) = vItem(3)
arrOutput(i, 6) = vItem(4)
Next i
ws.Range("A2").Resize(UBound(arrOutput, 1), 5).Value = arrOutput
' 再输出警告
For i = 1 To pWarnings.count
vItem = pWarnings(i)
arrOutput(pErrors.count + i, 1) = "警告"
arrOutput(pErrors.count + i, 2) = vItem(0)
arrOutput(pErrors.count + i, 3) = vItem(1)
arrOutput(pErrors.count + i, 4) = vItem(2)
arrOutput(pErrors.count + i, 5) = vItem(3)
arrOutput(pErrors.count + i, 6) = vItem(4)
Next i
ws.Range("A2").Resize(totalIssues, 6).Value = arrOutput
' 标记错误和警告行
If totalIssues > 0 Then
Dim rngErrors As Range
Dim rngWarnings As Range
If pErrors.count > 0 Then
Set rngErrors = ws.Range("A2").Resize(pErrors.count, 6)
rngErrors.Interior.Color = RGB(255, 200, 200)
End If
If pWarnings.count > 0 Then
Set rngWarnings = ws.Range("A" & (pErrors.count + 2)).Resize(pWarnings.count, 6)
rngWarnings.Interior.Color = RGB(255, 255, 200)
End If
End If
ws.Columns.AutoFit
End Sub

384
VBA_BOMConverter/Modules/M09_BOMExtractor.bas
View File

@@ -132,7 +132,7 @@ Public Function RunBOMExtraction() As String
Set wsOutput = WriteExtractionResults(allResults)
' 步骤6: 生成错误报告
If g_Logger.HasErrors Then
If g_Logger.HasIssues Then
g_Logger.PrintReport ActiveWorkbook
End If
@@ -165,6 +165,8 @@ Public Function RunBOMExtraction() As String
If g_Logger.HasErrors Then
msg = msg & vbCrLf & vbCrLf & "发现错误，已生成错误报告工作表。"
ElseIf g_Logger.HasWarnings Then
msg = msg & vbCrLf & vbCrLf & "发现警告，已生成错误报告工作表。"
End If
RunBOMExtraction = msg
@@ -297,8 +299,8 @@ End Function
'
' 流程:
' 1. 解析型号，提取参数
' 2. 匹配所有物料类型
' 3. 验证部件组合
' 2. 匹配所有物料类型（两阶段：收集 → 验证）
' 3. 验证所有匹配结果
' 4. 生成输出行
' ------------------------------------------------------------------------------
Private Function ProcessSingleModel( _
@@ -323,15 +325,12 @@ Private Function ProcessSingleModel( _
Exit Function
End If
' 步骤2: 匹配所有物料类型
' 步骤2: 匹配所有物料类型（两阶段）
Dim allMaterials As Collection
Set allMaterials = MatchAllMaterialTypes(params, bomWb, logger)
' 步骤3: 验证部件组合
Dim validation As Object
Set validation = M08_ComponentProcessor.ValidateComponentCombination(allMaterials)
Set allMaterials = MatchAllMaterialTypesWithValidation(params, bomWb, logger, validation)
' 步骤4: 生成输出行
' 步骤3: 生成输出行
Dim remarks As String
remarks = ""
@@ -365,33 +364,40 @@ ErrorHandler:
End Function
' ------------------------------------------------------------------------------
' 匹配所有物料类型
' 匹配所有物料类型（两阶段：收集 → 验证）
'
' 输入:
' params - 参数字典
' bomWb - BOM库工作簿
' logger - 错误记录器
' validation - 输出参数，返回验证结果
'
' 输出:
' Collection - 所有匹配到的物料集合
'
' 逻辑:
' - 遍历BOM库中的所有工作表
' - 对每个工作表尝试匹配
' Phase 1: 收集阶段 - 遍历BOM库中的所有工作表，收集匹配结果（不记录错误）
' Phase 2: 验证阶段 - 统一验证所有结果，记录错误和警告
' Phase 3: 生成最终物料集合
'
' 特殊处理:
' - "部件"工作表特殊处理（调用M08_ComponentProcessor）
' - 其他工作表使用M07_BOMMatcher匹配
' - 部件、接头、弹性元件的交叉验证
' ------------------------------------------------------------------------------
Private Function MatchAllMaterialTypes( _
Private Function MatchAllMaterialTypesWithValidation( _
ByVal params As Object, _
ByVal bomWb As Workbook, _
ByVal logger As clsErrorLogger _
ByVal logger As clsErrorLogger, _
ByRef outValidation As Object _
) As Collection
On Error GoTo ErrorHandler
Dim allMaterials As Collection
Set allMaterials = New Collection
' ========================================
' Phase 1: 收集所有工作表的匹配结果
' ========================================
Dim resultsDict As Object
Set resultsDict = CreateObject("Scripting.Dictionary")
' 遍历BOM库中的所有工作表
Dim ws As Worksheet
For Each ws In bomWb.Worksheets
Dim sheetName As String
@@ -399,6 +405,15 @@ Private Function MatchAllMaterialTypes( _
Debug.Print "=== 处理工作表: [" & sheetName & "] ==="
' 创建匹配结果对象
Dim matchResult As Object
Set matchResult = CreateObject("Scripting.Dictionary")
matchResult("sheetName") = sheetName
matchResult("success") = False
matchResult("rowCount") = 0
Set matchResult("rowNums") = New Collection
Set matchResult("materials") = New Collection
' "部件"工作表特殊处理
If sheetName = BOMLIB_SHEET_COMPONENT Then
Debug.Print " -> 使用部件处理逻辑"
@@ -409,62 +424,340 @@ Private Function MatchAllMaterialTypes( _
Debug.Print " -> 返回物料数: " & componentMaterials.count
matchResult("success") = (componentMaterials.count > 0)
matchResult("rowCount") = componentMaterials.count
Dim compMat As Variant
For Each compMat In componentMaterials
Debug.Print " [" & compMat("materialType") & "] 名称=[" & compMat("materialName") & "] 编码=[" & compMat("materialCode") & "]"
allMaterials.Add compMat
matchResult("materials").Add compMat
Next compMat
Else
' 其他工作表使用标准匹配逻辑
' 匹配记录
Dim matchResult As Object
Set matchResult = M07_BOMMatcher.MatchBOMRecord(ws, params)
Dim bomMatchResult As Object
Set bomMatchResult = M07_BOMMatcher.MatchBOMRecord(ws, params)
Debug.Print " -> 匹配结果: " & matchResult("success") & ", 行数: " & matchResult("rowCount")
Debug.Print " -> 匹配结果: " & bomMatchResult("success") & ", 行数: " & bomMatchResult("rowCount")
matchResult("success") = bomMatchResult("success")
matchResult("rowCount") = bomMatchResult("rowCount")
Set matchResult("rowNums") = bomMatchResult("rowNums")
' 如果匹配成功，提取物料信息
If matchResult("success") Then
If bomMatchResult("success") Then
Dim rowNum As Long
rowNum = matchResult("rowNums")(1)
rowNum = bomMatchResult("rowNums")(1)
Debug.Print " -> 匹配行号: " & rowNum
Dim headerMap As Object
Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(ws)
Debug.Print " -> 表头映射键数: " & headerMap.count
Dim materialInfo As Object
Set materialInfo = M07_BOMMatcher.ExtractMaterialInfo(ws, rowNum, headerMap)
Debug.Print " -> 提取结果: 名称=[" & materialInfo("materialName") & "] 编码=[" & materialInfo("materialCode") & "] 数量=[" & materialInfo("materialQty") & "]"
If Not materialInfo Is Nothing Then
allMaterials.Add materialInfo
Debug.Print " -> 已添加到物料集合"
matchResult("materials").Add materialInfo
Debug.Print " -> 已添加到匹配结果"
Else
Debug.Print " -> ERROR: materialInfo为Nothing"
End If
Else
' 匹配失败，记录错误（但不中断处理）
If matchResult("rowCount") = 0 Then
logger.Record 0, "M09.MatchAllMaterialTypes", "BOMMatchError", _
sheetName & " " & matchResult("message"), ""
Debug.Print " -> 未匹配到记录"
End If
End If
End If
' 将匹配结果存入字典
resultsDict.Add sheetName, matchResult
Debug.Print ""
Next ws
Set MatchAllMaterialTypes = allMaterials
' ========================================
' Phase 2: 统一验证所有匹配结果
' ========================================
Dim validationResult As Object
Set validationResult = ValidateAllMatchResults(resultsDict, logger)
' ========================================
' Phase 3: 根据验证结果生成最终物料集合
' ========================================
Dim allMaterials As Collection
Set allMaterials = New Collection
If validationResult("valid") Then
' 验证通过，收集所有物料
Dim resultKey As Variant
For Each resultKey In resultsDict.Keys
Dim result As Object
Set result = resultsDict(resultKey)
Dim mat As Variant
For Each mat In result("materials")
allMaterials.Add mat
Next mat
Next resultKey
Else
' 验证失败，仍然收集物料以便在输出中显示错误
Dim resultKey2 As Variant
For Each resultKey2 In resultsDict.Keys
Dim result2 As Object
Set result2 = resultsDict(resultKey2)
Dim mat2 As Variant
For Each mat2 In result2("materials")
allMaterials.Add mat2
Next mat2
Next resultKey2
End If
' 设置输出参数
Set outValidation = validationResult
Set MatchAllMaterialTypesWithValidation = allMaterials
Exit Function
ErrorHandler:
If Not logger Is Nothing Then
logger.Record 0, "M09.MatchAllMaterialTypes", "SystemError", _
logger.Record 0, "M09.MatchAllMaterialTypesWithValidation", "SystemError", _
"匹配物料类型失败: " & Err.Description, ""
End If
Set MatchAllMaterialTypes = allMaterials
Dim emptyColl As Collection
Set emptyColl = New Collection
Set MatchAllMaterialTypesWithValidation = emptyColl
End Function
' ------------------------------------------------------------------------------
' 统一验证所有工作表的匹配结果
'
' 输入:
' resultsDict - 所有工作表的匹配结果字典
' logger - 错误记录器
'
' 输出:
' Object - 验证结果对象
' .valid - Boolean，验证是否通过
' .message - String，错误/警告消息
'
' 验证规则:
' 1. 基础规则（所有工作表）:
' - 恰好匹配1条记录 → 正常
' - 匹配0条记录 → 错误（部件/接头/弹性元件除外）
' - 匹配2+条记录 → 错误
'
' 2. 特殊规则（部件、接头、弹性元件）:
' - 互斥关系验证
' - 组合完整性验证
' - 警告处理
' ------------------------------------------------------------------------------
Private Function ValidateAllMatchResults( _
ByVal resultsDict As Object, _
ByVal logger As clsErrorLogger _
) As Object
On Error GoTo ErrorHandler
Dim validation As Object
Set validation = CreateObject("Scripting.Dictionary")
validation("valid") = True
validation("message") = ""
' ========================================
' 1. 基础验证：非特殊工作表必须恰好1条
' ========================================
Dim specialSheets As Variant
specialSheets = Array(BOMLIB_SHEET_COMPONENT, "接头", "弹性元件")
Dim errors As Collection
Set errors = New Collection
Dim warnings As Collection
Set warnings = New Collection
Dim sheetKey As Variant
For Each sheetKey In resultsDict.Keys
Dim result As Object
Set result = resultsDict(sheetKey)
Dim isSpecialSheet As Boolean
isSpecialSheet = False
Dim s As Variant
For Each s In specialSheets
If result("sheetName") = s Then
isSpecialSheet = True
Exit For
End If
Next s
If Not isSpecialSheet Then
If result("rowCount") = 0 Then
errors.Add result("sheetName") & " 未匹配到记录"
ElseIf result("rowCount") > 1 Then
errors.Add result("sheetName") & " 匹配到" & result("rowCount") & "条记录"
End If
End If
Next sheetKey
' ========================================
' 2. 统计特殊工作表的结果
' ========================================
Dim componentResult As Object
Set componentResult = Nothing
Dim jointResult As Object
Set jointResult = Nothing
Dim elementResult As Object
Set elementResult = Nothing
If resultsDict.Exists(BOMLIB_SHEET_COMPONENT) Then
Set componentResult = resultsDict(BOMLIB_SHEET_COMPONENT)
End If
If resultsDict.Exists("接头") Then
Set jointResult = resultsDict("接头")
End If
If resultsDict.Exists("弹性元件") Then
Set elementResult = resultsDict("弹性元件")
End If
' 统计[部件]工作表中返回的物料类型
Dim componentFromComponentSheet As Boolean
componentFromComponentSheet = False
Dim componentJointCount As Long
componentJointCount = 0
Dim componentElementCount As Long
componentElementCount = 0
If Not componentResult Is Nothing Then
Dim mat As Variant
For Each mat In componentResult("materials")
If mat("materialType") = BOMLIB_SHEET_COMPONENT Then
componentFromComponentSheet = True
ElseIf mat("materialType") = "接头" Then
componentJointCount = componentJointCount + 1
ElseIf mat("materialType") = "弹性元件" Then
componentElementCount = componentElementCount + 1
End If
Next mat
End If
' ========================================
' 3. 特殊验证：部件、接头、弹性元件
' ========================================
Dim jointFromSheet As Long
jointFromSheet = 0
Dim elementFromSheet As Long
elementFromSheet = 0
If Not jointResult Is Nothing Then
jointFromSheet = jointResult("rowCount")
End If
If Not elementResult Is Nothing Then
elementFromSheet = elementResult("rowCount")
End If
' 情况A: [部件]工作表返回了部件物料
If componentFromComponentSheet Then
' 检查独立工作表是否也匹配到了物料
If jointFromSheet > 0 Then
warnings.Add "存在[部件]物料，但[接头]工作表也匹配到" & jointFromSheet & "条记录，已忽略"
End If
If elementFromSheet > 0 Then
warnings.Add "存在[部件]物料，但[弹性元件]工作表也匹配到" & elementFromSheet & "条记录，已忽略"
End If
' 情况B: [部件]工作表返回了子件（接头+弹性元件）
ElseIf componentJointCount > 0 Or componentElementCount > 0 Then
If jointFromSheet > 0 Then
warnings.Add "[部件]工作表已返回接头，但[接头]工作表也匹配到" & jointFromSheet & "条记录，已忽略"
End If
If elementFromSheet > 0 Then
warnings.Add "[部件]工作表已返回弹性元件，但[弹性元件]工作表也匹配到" & elementFromSheet & "条记录，已忽略"
End If
' 情况C: [部件]工作表没有返回物料，使用独立工作表
Else
' 检查[部件]工作表本身是否匹配失败
Dim componentCount As Long
componentCount = 0
If Not componentResult Is Nothing Then
componentCount = componentResult("rowCount")
End If
If componentCount = 0 And (jointFromSheet = 0 Or elementFromSheet = 0) Then
errors.Add "部件、接头、弹性元件均未匹配或组合不完整"
ElseIf jointFromSheet > 1 Then
errors.Add "[接头]工作表匹配到" & jointFromSheet & "条记录"
ElseIf elementFromSheet > 1 Then
errors.Add "[弹性元件]工作表匹配到" & elementFromSheet & "条记录"
End If
End If
' ========================================
' 4. 处理[部件]工作表的多条匹配
' ========================================
If Not componentResult Is Nothing Then
If componentResult("rowCount") > 1 Then
errors.Add "[部件]工作表匹配到" & componentResult("rowCount") & "条记录"
End If
End If
' ========================================
' 5. 记录错误和警告
' ========================================
Dim err As Variant
For Each err In errors
logger.Record 0, "M09.ValidateAllMatchResults", "BOMMatchError", CStr(err), ""
Next err
Dim warn As Variant
For Each warn In warnings
logger.RecordWarning 0, "M09.ValidateAllMatchResults", "ComponentConflict", CStr(warn), ""
Next warn
' ========================================
' 6. 生成验证结果
' ========================================
If errors.count > 0 Then
validation("valid") = False
validation("message") = Join(ToArray(errors), "; ")
ElseIf warnings.count > 0 Then
validation("valid") = True ' 警告不影响验证结果
validation("message") = Join(ToArray(warnings), "; ")
End If
Set ValidateAllMatchResults = validation
Exit Function
ErrorHandler:
If Not logger Is Nothing Then
logger.Record 0, "M09.ValidateAllMatchResults", "SystemError", _
"验证匹配结果失败: " & Err.Description, ""
End If
validation("valid") = False
validation("message") = "验证过程发生系统错误"
Set ValidateAllMatchResults = validation
End Function
' ------------------------------------------------------------------------------
' 辅助函数：将Collection转换为数组
' ------------------------------------------------------------------------------
Private Function ToArray(ByVal coll As Collection) As Variant
Dim arr() As Variant
ReDim arr(1 To coll.count) As Variant
Dim i As Long
For i = 1 To coll.count
arr(i) = coll(i)
Next i
ToArray = arr
End Function
' ------------------------------------------------------------------------------
@@ -648,10 +941,17 @@ Private Function WriteExtractionResults(ByVal results As Collection) As Workshee
.Borders.Weight = xlThin
End With
' 如果有错误备注，标红
' 如果有错误备注，标红；如果有警告，标黄
For i = 1 To results.count
If Len(CStr(outputArr(i, 12))) > 0 And InStr(CStr(outputArr(i, 12)), "错误") > 0 Then
ws.Cells(i + 1, 12).Interior.Color = RGB(255, 200, 200)
Dim remarkText As String
remarkText = CStr(outputArr(i, 12))
If Len(remarkText) > 0 Then
If InStr(remarkText, "错误") > 0 Then
ws.Cells(i + 1, 12).Interior.Color = RGB(255, 200, 200)
ElseIf InStr(remarkText, "警告") > 0 Or InStr(remarkText, "已忽略") > 0 Then
ws.Cells(i + 1, 12).Interior.Color = RGB(255, 255, 200)
End If
End If
Next i
End If