All checks were successful
NTFY Notification / notify (push) Successful in 3s
Implement edge material validation logic that behaves differently based on azxs value: - When azxs is A0, Z0, or B0: Edge material is NOT required (0 matches = OK, 1+ matches = ERROR) - When azxs is AH, AT, BH, BT, BZ, ZH, ZT, or ZZ: Standard validation applies (exactly 1 match required) - Supports dual-value azxs format (e.g., "A0,径向" extracts "A0" for validation) Changes: - M09_BOMExtractor.bas: - Update MatchAllMaterialTypesWithValidation to pass params to validation - Update ValidateAllMatchResults signature to accept params parameter - Add "边" to special sheets array - Implement Phase 3.5: Edge material validation with azxs-based rules - Update function header comments - docs/BOM匹配错误判断机制详解.md: - Add section 6.5: Edge material special handling - Update error type table with EdgeMaterialError - Update function index and version history Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
1152 lines
37 KiB
QBasic
1152 lines
37 KiB
QBasic
' ==============================================================================
|
||
' 模块: M09_BOMExtractor
|
||
' 职责: BOM自动提取系统的主流程编排和结果输出
|
||
'
|
||
' 主要流程:
|
||
' 1. 读取输入工作表中的产品型号列表
|
||
' 2. 打开BOM库.xlsx文件
|
||
' 3. 对于每个产品型号:
|
||
' a. 解析型号,提取参数(M06_ModelParser)
|
||
' b. 遍历BOM库工作表,匹配物料(M07_BOMMatcher)
|
||
' c. 特殊处理"部件"物料(M08_ComponentProcessor)
|
||
' d. 验证部件组合规则
|
||
' e. 生成输出行
|
||
' 4. 将结果写入"BOM提取结果"工作表
|
||
' 5. 生成错误报告
|
||
'
|
||
' 输出格式:
|
||
' - 纵向展开格式,每个物料一行
|
||
' - 列: 原始产品型号, azxs, bkxs, gclj, jycz, lcfw, fjgn,
|
||
' 物料类型, 物料名称, 物料编码, 物料数量, 提取备注
|
||
' ==============================================================================
|
||
Option Explicit
|
||
|
||
' 模块级常量 - 映射表配置
|
||
Private Const MAPPING_SHEET_NAME As String = "对照表"
|
||
|
||
' 模块级变量
|
||
Private g_Logger As clsErrorLogger
|
||
Private g_BOMWorkbook As Workbook
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 主入口: 运行BOM提取流程
|
||
'
|
||
' 输入: 无(从活动工作簿读取输入)
|
||
'
|
||
' 输出:
|
||
' String - 处理结果消息
|
||
'
|
||
' 流程:
|
||
' 1. 初始化环境
|
||
' 2. 读取输入产品型号
|
||
' 3. 打开BOM库文件
|
||
' 4. 处理每个产品型号
|
||
' 5. 写入结果到工作表
|
||
' 6. 生成错误报告
|
||
'
|
||
' 示例调用:
|
||
' Dim result As String
|
||
' result = M09_BOMExtractor.RunBOMExtraction()
|
||
' MsgBox result
|
||
' ------------------------------------------------------------------------------
|
||
Public Function RunBOMExtraction() As String
|
||
On Error GoTo MainErrorHandler
|
||
|
||
' 初始化
|
||
Set g_Logger = New clsErrorLogger
|
||
Set g_BOMWorkbook = Nothing
|
||
|
||
Application.ScreenUpdating = False
|
||
Application.Calculation = xlCalculationManual
|
||
Application.DisplayAlerts = False
|
||
|
||
' 步骤1: 检查输入工作表
|
||
Dim wsInput As Worksheet
|
||
Set wsInput = ThisWorkbook.Worksheets("产品型号")
|
||
|
||
If wsInput Is Nothing Then
|
||
RunBOMExtraction = "错误:未找到输入工作表。工作表名称应包含'" & INPUT_COL_MODEL & "'或'" & INPUT_COL_PRODUCT_MODEL & "'。"
|
||
GoTo ExitHandler
|
||
End If
|
||
|
||
Application.StatusBar = "正在读取输入数据..."
|
||
|
||
' 步骤2: 读取输入产品型号
|
||
Dim inputModels As Variant
|
||
inputModels = ReadInputModels(wsInput)
|
||
|
||
If IsEmpty(inputModels) Then
|
||
RunBOMExtraction = "错误:未找到产品型号数据。请检查工作表中是否有数据。"
|
||
GoTo ExitHandler
|
||
End If
|
||
|
||
' 步骤3: 打开BOM库文件
|
||
Application.StatusBar = "正在打开BOM库文件..."
|
||
|
||
Set g_BOMWorkbook = OpenBOMLibrary()
|
||
|
||
If g_BOMWorkbook Is Nothing Then
|
||
RunBOMExtraction = "错误:无法打开BOM库文件。请确保[" & BOMLIB_FILENAME & "]与当前工作簿在同一目录下。"
|
||
GoTo ExitHandler
|
||
End If
|
||
|
||
' 初始化各模块
|
||
M06_ModelParser.InitModelParser g_Logger
|
||
M07_BOMMatcher.InitBOMMatcher g_Logger
|
||
M08_ComponentProcessor.InitComponentProcessor g_Logger
|
||
|
||
' 初始化映射器(新增)
|
||
If WorksheetExists(MAPPING_SHEET_NAME) Then
|
||
Dim wsMapping As Worksheet
|
||
Set wsMapping = ThisWorkbook.Sheets(MAPPING_SHEET_NAME)
|
||
M06A_Mapper.InitMapper g_Logger, wsMapping
|
||
Else
|
||
If Not g_Logger Is Nothing Then
|
||
g_Logger.RecordWarning 0, "M09.RunBOMExtraction", "MappingTableMissing", _
|
||
"未找到对照表工作表,azxs和lcfw将仅使用原始值匹配", ""
|
||
End If
|
||
End If
|
||
|
||
' 步骤4: 处理每个产品型号
|
||
Application.StatusBar = "正在处理产品型号..."
|
||
|
||
Dim allResults As Collection
|
||
Set allResults = New Collection
|
||
|
||
Dim i As Long
|
||
Dim totalModels As Long
|
||
totalModels = UBound(inputModels, 1)
|
||
|
||
For i = LBound(inputModels, 1) To UBound(inputModels, 1)
|
||
' 进度更新
|
||
If i Mod 10 = 0 Then
|
||
Dim pct As Long
|
||
pct = CLng((i / totalModels) * 100)
|
||
Application.StatusBar = "正在处理: " & pct & "% | 型号: " & i & "/" & totalModels
|
||
DoEvents
|
||
End If
|
||
|
||
' 处理单个型号
|
||
Dim modelString As String
|
||
modelString = CStr(inputModels(i, 1))
|
||
|
||
Dim modelResults As Collection
|
||
Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger)
|
||
|
||
' 合并结果
|
||
Dim result As Variant
|
||
For Each result In modelResults
|
||
allResults.Add result
|
||
Next result
|
||
Next i
|
||
|
||
' 步骤5: 写入结果到工作表
|
||
Application.StatusBar = "正在写入结果..."
|
||
|
||
Dim wsOutput As Worksheet
|
||
Set wsOutput = WriteExtractionResults(allResults)
|
||
|
||
' 步骤6: 生成错误报告
|
||
If g_Logger.HasIssues Then
|
||
g_Logger.PrintReport ActiveWorkbook
|
||
End If
|
||
|
||
' 关闭BOM库文件
|
||
If Not g_BOMWorkbook Is Nothing Then
|
||
g_BOMWorkbook.Close SaveChanges:=False
|
||
Set g_BOMWorkbook = Nothing
|
||
End If
|
||
|
||
' 构建返回消息
|
||
Dim successCount As Long
|
||
Dim errorCount As Long
|
||
successCount = 0
|
||
errorCount = 0
|
||
|
||
For Each result In allResults
|
||
If Len(CStr(result(12))) = 0 Then ' 第12列是备注
|
||
successCount = successCount + 1
|
||
Else
|
||
errorCount = errorCount + 1
|
||
End If
|
||
Next result
|
||
|
||
Dim msg As String
|
||
msg = "BOM提取完成!" & vbCrLf & _
|
||
"处理型号数: " & totalModels & vbCrLf & _
|
||
"提取物料数: " & allResults.count & vbCrLf & _
|
||
"成功数: " & successCount & vbCrLf & _
|
||
"异常数: " & errorCount
|
||
|
||
If g_Logger.HasErrors Then
|
||
msg = msg & vbCrLf & vbCrLf & "发现错误,已生成错误报告工作表。"
|
||
ElseIf g_Logger.HasWarnings Then
|
||
msg = msg & vbCrLf & vbCrLf & "发现警告,已生成错误报告工作表。"
|
||
End If
|
||
|
||
RunBOMExtraction = msg
|
||
GoTo ExitHandler
|
||
|
||
MainErrorHandler:
|
||
RunBOMExtraction = "发生运行时错误: " & Err.Description & " (错误号: " & Err.Number & ")"
|
||
|
||
ExitHandler:
|
||
' 清理
|
||
Application.StatusBar = False
|
||
Application.ScreenUpdating = True
|
||
Application.Calculation = xlCalculationAutomatic
|
||
Application.DisplayAlerts = True
|
||
|
||
' 确保关闭BOM库文件
|
||
If Not g_BOMWorkbook Is Nothing Then
|
||
On Error Resume Next
|
||
g_BOMWorkbook.Close SaveChanges:=False
|
||
On Error GoTo 0
|
||
Set g_BOMWorkbook = Nothing
|
||
End If
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 获取输入工作表
|
||
'
|
||
' 输入: 无(从活动工作簿查找)
|
||
'
|
||
' 输出:
|
||
' Worksheet - 包含产品型号列的工作表
|
||
'
|
||
' 逻辑:
|
||
' - 优先查找名为"产品型号"的工作表
|
||
' - 如果不存在,查找包含"型号"或"产品型号"列的工作表
|
||
' ------------------------------------------------------------------------------
|
||
Private Function GetInputWorksheet() As Worksheet
|
||
On Error Resume Next
|
||
|
||
' 方法1: 查找名为"产品型号"的工作表
|
||
Set GetInputWorksheet = ActiveWorkbook.Sheets(INPUT_COL_PRODUCT_MODEL)
|
||
|
||
If Not GetInputWorksheet Is Nothing Then
|
||
Exit Function
|
||
End If
|
||
|
||
' 方法2: 查找包含"型号"列的工作表
|
||
Dim ws As Worksheet
|
||
For Each ws In ActiveWorkbook.Worksheets
|
||
Dim headerCell As Range
|
||
Set headerCell = ws.Rows(1).Find(INPUT_COL_MODEL, LookAt:=xlWhole, MatchCase:=False)
|
||
|
||
If Not headerCell Is Nothing Then
|
||
Set GetInputWorksheet = ws
|
||
Exit Function
|
||
End If
|
||
|
||
Set headerCell = ws.Rows(1).Find(INPUT_COL_PRODUCT_MODEL, LookAt:=xlWhole, MatchCase:=False)
|
||
|
||
If Not headerCell Is Nothing Then
|
||
Set GetInputWorksheet = ws
|
||
Exit Function
|
||
End If
|
||
Next ws
|
||
|
||
Set GetInputWorksheet = Nothing
|
||
On Error GoTo 0
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 读取输入产品型号
|
||
'
|
||
' 输入:
|
||
' ws - 输入工作表
|
||
'
|
||
' 输出:
|
||
' Variant - 二维数组,包含产品型号列表
|
||
'
|
||
' 注意:
|
||
' - 自动查找"型号"或"产品型号"列
|
||
' - 从第2行开始读取(第1行是表头)
|
||
' ------------------------------------------------------------------------------
|
||
Private Function ReadInputModels(ByVal ws As Worksheet) As Variant
|
||
On Error GoTo ErrorHandler
|
||
|
||
' 查找型号列
|
||
Dim headerCell As Range
|
||
Set headerCell = ws.Rows(1).Find(INPUT_COL_PRODUCT_MODEL, LookAt:=xlPart, MatchCase:=False)
|
||
|
||
If headerCell Is Nothing Then
|
||
Set headerCell = ws.Rows(1).Find(INPUT_COL_MODEL, LookAt:=xlPart, MatchCase:=False)
|
||
End If
|
||
|
||
If headerCell Is Nothing Then
|
||
ReadInputModels = Empty
|
||
Exit Function
|
||
End If
|
||
|
||
Dim colIdx As Long
|
||
colIdx = headerCell.Column
|
||
|
||
' 查找最后一行
|
||
Dim lastRow As Long
|
||
lastRow = ws.Cells(ws.Rows.count, colIdx).End(xlUp).row
|
||
|
||
If lastRow < 2 Then
|
||
ReadInputModels = Empty
|
||
Exit Function
|
||
End If
|
||
|
||
' 读取数据到数组
|
||
ReadInputModels = ws.Range(ws.Cells(2, colIdx), ws.Cells(lastRow, colIdx)).Value
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
ReadInputModels = Empty
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 处理单个产品型号
|
||
'
|
||
' 输入:
|
||
' modelString - 产品型号字符串
|
||
' bomWb - BOM库工作簿
|
||
' logger - 错误记录器
|
||
'
|
||
' 输出:
|
||
' Collection - 提取结果集合
|
||
' 每个元素是一个数组,包含12列数据
|
||
'
|
||
' 流程:
|
||
' 1. 解析型号,提取参数
|
||
' 2. 匹配所有物料类型(两阶段:收集 → 验证)
|
||
' 3. 验证所有匹配结果
|
||
' 4. 生成输出行
|
||
' ------------------------------------------------------------------------------
|
||
Private Function ProcessSingleModel( _
|
||
ByVal modelString As String, _
|
||
ByVal bomWb As Workbook, _
|
||
ByVal logger As clsErrorLogger _
|
||
) As Collection
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim results As Collection
|
||
Set results = New Collection
|
||
|
||
' 步骤1: 解析型号
|
||
Dim params As Object
|
||
Set params = M06_ModelParser.ParseProductModel(modelString)
|
||
|
||
' 检查解析是否成功
|
||
If params.count = 0 Then
|
||
' 解析失败,添加错误行
|
||
results.Add GenerateErrorRow(modelString, "型号解析失败:型号格式不正确或缺少必要字段")
|
||
Set ProcessSingleModel = results
|
||
Exit Function
|
||
End If
|
||
|
||
' 步骤2: 匹配所有物料类型(两阶段)
|
||
Dim allMaterials As Collection
|
||
Dim validation As Object
|
||
Set allMaterials = MatchAllMaterialTypesWithValidation(params, bomWb, logger, validation)
|
||
|
||
' 步骤3: 生成输出行
|
||
Dim remarks As String
|
||
remarks = ""
|
||
|
||
If Not validation("valid") Then
|
||
remarks = validation("message")
|
||
End If
|
||
|
||
Dim mat As Variant
|
||
For Each mat In allMaterials
|
||
Dim outputRow As Variant
|
||
outputRow = GenerateMaterialRow(modelString, params, mat, remarks)
|
||
results.Add outputRow
|
||
Next mat
|
||
|
||
' 如果没有匹配到任何物料,添加错误行
|
||
If allMaterials.count = 0 Then
|
||
results.Add GenerateErrorRow(modelString, "未匹配到任何物料")
|
||
End If
|
||
|
||
Set ProcessSingleModel = results
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
If Not logger Is Nothing Then
|
||
logger.Record 0, "M09.ProcessSingleModel", "SystemError", _
|
||
"处理型号[" & modelString & "]失败: " & Err.Description, ""
|
||
End If
|
||
|
||
results.Add GenerateErrorRow(modelString, "系统错误: " & Err.Description)
|
||
Set ProcessSingleModel = results
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 匹配所有物料类型(两阶段:收集 → 验证)
|
||
'
|
||
' 输入:
|
||
' params - 参数字典
|
||
' bomWb - BOM库工作簿
|
||
' logger - 错误记录器
|
||
' validation - 输出参数,返回验证结果
|
||
'
|
||
' 输出:
|
||
' Collection - 所有匹配到的物料集合
|
||
'
|
||
' 逻辑:
|
||
' Phase 1: 收集阶段 - 遍历BOM库中的所有工作表,收集匹配结果(不记录错误)
|
||
' Phase 2: 验证阶段 - 统一验证所有结果,记录错误和警告
|
||
' Phase 3: 生成最终物料集合
|
||
'
|
||
' 特殊处理:
|
||
' - "部件"工作表特殊处理(调用M08_ComponentProcessor)
|
||
' - 部件、接头、弹性元件的交叉验证
|
||
' - 边材料基于azxs参数的特殊验证(A0/Z0/B0不需要边,AH/AT等需要边)
|
||
' ------------------------------------------------------------------------------
|
||
Private Function MatchAllMaterialTypesWithValidation( _
|
||
ByVal params As Object, _
|
||
ByVal bomWb As Workbook, _
|
||
ByVal logger As clsErrorLogger, _
|
||
ByRef outValidation As Object _
|
||
) As Collection
|
||
On Error GoTo ErrorHandler
|
||
|
||
' ========================================
|
||
' Phase 1: 收集所有工作表的匹配结果
|
||
' ========================================
|
||
Dim resultsDict As Object
|
||
Set resultsDict = CreateObject("Scripting.Dictionary")
|
||
|
||
Dim ws As Worksheet
|
||
For Each ws In bomWb.Worksheets
|
||
Dim sheetName As String
|
||
sheetName = ws.Name
|
||
|
||
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
|
||
|
||
' "部件"工作表特殊处理
|
||
Dim componentMaterials As Collection
|
||
If sheetName = BOMLIB_SHEET_COMPONENT Then
|
||
Debug.Print " -> 使用部件处理逻辑"
|
||
|
||
' 步骤1: 先调用标准匹配获取匹配行数(这是工作表匹配的行数,不是物料数量)
|
||
Dim bomMatchResult As Object
|
||
Set bomMatchResult = M07_BOMMatcher.MatchBOMRecord(ws, params)
|
||
|
||
Debug.Print " -> 标准匹配: success=" & bomMatchResult("success") & ", rowCount=" & bomMatchResult("rowCount")
|
||
|
||
' 步骤2: 如果标准匹配成功,调用部件处理器
|
||
|
||
Set componentMaterials = New Collection
|
||
|
||
If bomMatchResult("success") Then
|
||
Set componentMaterials = M08_ComponentProcessor.ProcessComponentRecord( _
|
||
ws, params, logger, bomMatchResult("rowNums")(1))
|
||
|
||
Debug.Print " -> 返回物料数: " & componentMaterials.count
|
||
End If
|
||
|
||
' 步骤3: 创建匹配结果对象,使用标准匹配的rowCount(工作表行数,不是物料数)
|
||
matchResult("success") = bomMatchResult("success")
|
||
matchResult("rowCount") = bomMatchResult("rowCount") ' ✅ 关键修复:使用标准匹配的rowCount
|
||
Set matchResult("rowNums") = bomMatchResult("rowNums")
|
||
|
||
' 步骤4: 添加物料到匹配结果
|
||
Dim compMat As Variant
|
||
For Each compMat In componentMaterials
|
||
Debug.Print " [" & compMat("materialType") & "] 名称=[" & compMat("materialName") & "] 编码=[" & compMat("materialCode") & "]"
|
||
matchResult("materials").Add compMat
|
||
Next compMat
|
||
Else
|
||
' 其他工作表使用标准匹配逻辑
|
||
Set bomMatchResult = M07_BOMMatcher.MatchBOMRecord(ws, params)
|
||
|
||
Debug.Print " -> 匹配结果: " & bomMatchResult("success") & ", 行数: " & bomMatchResult("rowCount")
|
||
|
||
matchResult("success") = bomMatchResult("success")
|
||
matchResult("rowCount") = bomMatchResult("rowCount")
|
||
Set matchResult("rowNums") = bomMatchResult("rowNums")
|
||
|
||
' 如果匹配成功,提取物料信息
|
||
If bomMatchResult("success") Then
|
||
Dim rowNum As Long
|
||
rowNum = bomMatchResult("rowNums")(1)
|
||
Debug.Print " -> 匹配行号: " & rowNum
|
||
|
||
Dim headerMap As Object
|
||
Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(ws)
|
||
|
||
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
|
||
matchResult("materials").Add materialInfo
|
||
Debug.Print " -> 已添加到匹配结果"
|
||
Else
|
||
Debug.Print " -> ERROR: materialInfo为Nothing"
|
||
End If
|
||
End If
|
||
End If
|
||
|
||
' 将匹配结果存入字典
|
||
resultsDict.Add sheetName, matchResult
|
||
Debug.Print ""
|
||
Next ws
|
||
|
||
' ========================================
|
||
' Phase 2: 统一验证所有匹配结果
|
||
' ========================================
|
||
Dim validationResult As Object
|
||
Set validationResult = ValidateAllMatchResults(resultsDict, logger, params)
|
||
|
||
' ========================================
|
||
' 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.MatchAllMaterialTypesWithValidation", "SystemError", _
|
||
"匹配物料类型失败: " & Err.Description, ""
|
||
End If
|
||
|
||
Dim emptyColl As Collection
|
||
Set emptyColl = New Collection
|
||
Set MatchAllMaterialTypesWithValidation = emptyColl
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 统一验证所有工作表的匹配结果
|
||
'
|
||
' 输入:
|
||
' resultsDict - 所有工作表的匹配结果字典
|
||
' logger - 错误记录器
|
||
' params - 产品型号参数字典(用于边材料验证)
|
||
'
|
||
' 输出:
|
||
' Object - 验证结果对象
|
||
' .valid - Boolean,验证是否通过
|
||
' .message - String,错误/警告消息
|
||
'
|
||
' 验证规则:
|
||
' 1. 基础规则(所有工作表):
|
||
' - 恰好匹配1条记录 → 正常
|
||
' - 匹配0条记录 → 错误(部件/接头/弹性元件/边除外)
|
||
' - 匹配2+条记录 → 错误
|
||
'
|
||
' 2. 特殊规则(部件、接头、弹性元件):
|
||
' - 互斥关系验证
|
||
' - 组合完整性验证
|
||
' - 警告处理
|
||
'
|
||
' 3. 特殊规则(边材料):
|
||
' - azxs=A0/Z0/B0 → 不需要边(0条=OK,1+条=ERROR)
|
||
' - azxs=AH/AT/BH/BT/BZ/ZH/ZT/ZZ → 需要边(1条=OK)
|
||
' - 支持双值格式(如"A0,径向")
|
||
' ------------------------------------------------------------------------------
|
||
Private Function ValidateAllMatchResults( _
|
||
ByVal resultsDict As Object, _
|
||
ByVal logger As clsErrorLogger, _
|
||
ByVal params As Object _
|
||
) 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, "接头", "弹性元件", BOMLIB_SHEET_EDGE)
|
||
|
||
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
|
||
|
||
' ========================================
|
||
' 3.5. 特殊验证:边 (Edge) 材料
|
||
' ========================================
|
||
Dim edgeResult As Object
|
||
Set edgeResult = Nothing
|
||
|
||
If resultsDict.Exists(BOMLIB_SHEET_EDGE) Then
|
||
Set edgeResult = resultsDict(BOMLIB_SHEET_EDGE)
|
||
End If
|
||
|
||
' 检查azxs参数值
|
||
Dim azxsValue As String
|
||
Dim rawAzxs As String
|
||
azxsValue = ""
|
||
rawAzxs = ""
|
||
|
||
If params.Exists("azxs") Then
|
||
azxsValue = CStr(params("azxs"))
|
||
' 提取原始azxs值(处理双值格式如"A0,径向")
|
||
If InStr(azxsValue, ",") > 0 Then
|
||
rawAzxs = Trim(CStr(Split(azxsValue, ",")(0)))
|
||
Else
|
||
rawAzxs = Trim(azxsValue)
|
||
End If
|
||
End If
|
||
|
||
' 定义不需要边的azxs值
|
||
Dim noEdgeAzxs As Variant
|
||
noEdgeAzxs = Array("A0", "Z0", "B0")
|
||
|
||
' 定义需要边的azxs值(有后缀H/T/Z的值)
|
||
Dim hasEdgeAzxs As Variant
|
||
hasEdgeAzxs = Array("AH", "AT", "BH", "BT", "BZ", "ZH", "ZT", "ZZ")
|
||
|
||
' 检查是否为不需要边的azxs值
|
||
Dim isNoEdgeCase As Boolean
|
||
isNoEdgeCase = False
|
||
|
||
Dim az As Variant
|
||
For Each az In noEdgeAzxs
|
||
If rawAzxs = az Then
|
||
isNoEdgeCase = True
|
||
Exit For
|
||
End If
|
||
Next az
|
||
|
||
' 情况A: azxs为A0/Z0/B0,不应该有边
|
||
If isNoEdgeCase Then
|
||
If Not edgeResult Is Nothing Then
|
||
If edgeResult("rowCount") > 0 Then
|
||
errors.Add "[边]工作表匹配到" & edgeResult("rowCount") & "条记录,但azxs=" & rawAzxs & "不需要边物料"
|
||
End If
|
||
End If
|
||
' 0条匹配是正常的,不记录错误或警告
|
||
|
||
' 情况B: azxs为AH/AT/BH/BT/BZ/ZH/ZT/ZZ,走常规判断
|
||
Else
|
||
' 检查是否为需要边的azxs值
|
||
Dim isHasEdgeCase As Boolean
|
||
isHasEdgeCase = False
|
||
|
||
For Each az In hasEdgeAzxs
|
||
If rawAzxs = az Then
|
||
isHasEdgeCase = True
|
||
Exit For
|
||
End If
|
||
Next az
|
||
|
||
If isHasEdgeCase Then
|
||
' 标准验证:恰好1条匹配
|
||
If Not edgeResult Is Nothing Then
|
||
If edgeResult("rowCount") = 0 Then
|
||
errors.Add "[边]未匹配到记录"
|
||
ElseIf edgeResult("rowCount") > 1 Then
|
||
errors.Add "[边]匹配到" & edgeResult("rowCount") & "条记录"
|
||
End If
|
||
Else
|
||
' 没有边的结果记录
|
||
errors.Add "[边]未匹配到记录"
|
||
End If
|
||
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
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 生成单行输出数据
|
||
'
|
||
' 输入:
|
||
' modelString - 原始产品型号
|
||
' params - 参数字典
|
||
' material - 物料信息字典
|
||
' remarks - 备注信息
|
||
'
|
||
' 输出:
|
||
' Variant - 包含12列数据的数组
|
||
'
|
||
' 列定义:
|
||
' 1: 原始产品型号
|
||
' 2: azxs
|
||
' 3: bkxs
|
||
' 4: gclj
|
||
' 5: jycz
|
||
' 6: lcfw
|
||
' 7: fjgn
|
||
' 8: 物料类型
|
||
' 9: 物料名称
|
||
' 10: 物料编码
|
||
' 11: 物料数量
|
||
' 12: 提取备注
|
||
' ------------------------------------------------------------------------------
|
||
Private Function GenerateMaterialRow( _
|
||
ByVal modelString As String, _
|
||
ByVal params As Object, _
|
||
ByVal material As Object, _
|
||
ByVal remarks As String _
|
||
) As Variant
|
||
Dim result(1 To 12) As Variant
|
||
|
||
' 第1列: 原始产品型号
|
||
result(1) = modelString
|
||
|
||
' 第2-7列: 参数值
|
||
result(2) = GetParamValue(params, "azxs")
|
||
result(3) = GetParamValue(params, "bkxs")
|
||
result(4) = GetParamValue(params, "gclj")
|
||
result(5) = GetParamValue(params, "jycz")
|
||
result(6) = GetParamValue(params, "lcfw")
|
||
result(7) = GetParamValue(params, "fjgn")
|
||
|
||
' 第8-11列: 物料信息
|
||
result(8) = GetMaterialValue(material, "materialType")
|
||
result(9) = GetMaterialValue(material, "materialName")
|
||
result(10) = GetMaterialValue(material, "materialCode")
|
||
result(11) = GetMaterialValue(material, "materialQty")
|
||
|
||
' 第12列: 备注
|
||
result(12) = remarks & " " & GetMaterialValue(material, "remarks")
|
||
result(12) = Trim(result(12))
|
||
|
||
GenerateMaterialRow = result
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 生成错误行
|
||
'
|
||
' 输入:
|
||
' modelString - 原始产品型号
|
||
' errorMessage - 错误消息
|
||
'
|
||
' 输出:
|
||
' Variant - 包含12列数据的数组(仅型号和备注有值)
|
||
' ------------------------------------------------------------------------------
|
||
Private Function GenerateErrorRow( _
|
||
ByVal modelString As String, _
|
||
ByVal errorMessage As String _
|
||
) As Variant
|
||
Dim result(1 To 12) As Variant
|
||
Dim i As Long
|
||
|
||
For i = 1 To 12
|
||
result(i) = ""
|
||
Next i
|
||
|
||
result(1) = modelString
|
||
result(12) = "错误: " & errorMessage
|
||
|
||
GenerateErrorRow = result
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 辅助函数: 从参数字典中获取值
|
||
' ------------------------------------------------------------------------------
|
||
Private Function GetParamValue(ByVal params As Object, ByVal key As String) As Variant
|
||
If params.Exists(key) Then
|
||
GetParamValue = params(key)
|
||
Else
|
||
GetParamValue = ""
|
||
End If
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 辅助函数: 从物料字典中获取值
|
||
' ------------------------------------------------------------------------------
|
||
Private Function GetMaterialValue(ByVal material As Object, ByVal key As String) As Variant
|
||
If material.Exists(key) Then
|
||
GetMaterialValue = material(key)
|
||
Else
|
||
GetMaterialValue = ""
|
||
End If
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 写入提取结果到工作表
|
||
'
|
||
' 输入:
|
||
' results - 提取结果集合
|
||
'
|
||
' 输出:
|
||
' Worksheet - 输出工作表
|
||
'
|
||
' 逻辑:
|
||
' 1. 创建或清空"BOM提取结果"工作表
|
||
' 2. 写入表头
|
||
' 3. 批量写入数据
|
||
' 4. 格式化工作表
|
||
' ------------------------------------------------------------------------------
|
||
Private Function WriteExtractionResults(ByVal results As Collection) As Worksheet
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim ws As Worksheet
|
||
|
||
' 创建或获取工作表
|
||
On Error Resume Next
|
||
Set ws = ThisWorkbook.Sheets(OUTPUT_SHEET_NAME)
|
||
On Error GoTo ErrorHandler
|
||
|
||
If ws Is Nothing Then
|
||
Set ws = ThisWorkbook.Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.count))
|
||
ws.Name = OUTPUT_SHEET_NAME
|
||
Else
|
||
ws.Cells.Clear
|
||
End If
|
||
|
||
' 写入表头
|
||
Dim headers As Variant
|
||
headers = Array("原始产品型号", "azxs", "bkxs", "gclj", "jycz", "lcfw", "fjgn", _
|
||
"物料类型", "物料名称", "物料编码", "物料数量", "提取备注")
|
||
|
||
Dim c As Long
|
||
For c = 1 To 12
|
||
ws.Cells(1, c).Value = headers(c - 1)
|
||
Next c
|
||
|
||
' 格式化表头
|
||
With ws.Range("A1:L1")
|
||
.Font.Bold = True
|
||
.Interior.Color = RGB(217, 217, 217)
|
||
.HorizontalAlignment = xlCenter
|
||
End With
|
||
|
||
' 写入数据
|
||
If results.count > 0 Then
|
||
Dim outputArr() As Variant
|
||
ReDim outputArr(1 To results.count, 1 To 12)
|
||
|
||
Dim i As Long
|
||
Dim result As Variant
|
||
|
||
For i = 1 To results.count
|
||
result = results(i)
|
||
|
||
Dim j As Long
|
||
For j = 1 To 12
|
||
outputArr(i, j) = result(j)
|
||
Next j
|
||
Next i
|
||
|
||
ws.Range("A2").Resize(results.count, 12).Value = outputArr
|
||
|
||
' 格式化数据区域
|
||
With ws.Range("A2:L" & (results.count + 1))
|
||
.Borders.LineStyle = xlContinuous
|
||
.Borders.Weight = xlThin
|
||
End With
|
||
|
||
' 如果有错误备注,标红;如果有警告,标黄
|
||
For i = 1 To results.count
|
||
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
|
||
|
||
' 自动调整列宽
|
||
ws.Columns.AutoFit
|
||
|
||
' 冻结首行
|
||
ws.Activate
|
||
ActiveWindow.FreezePanes = False
|
||
ws.Rows(2).Select
|
||
ActiveWindow.FreezePanes = True
|
||
ws.Cells(1, 1).Select
|
||
|
||
Set WriteExtractionResults = ws
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
Set WriteExtractionResults = Nothing
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 打开BOM库文件
|
||
'
|
||
' 输入: 无(从当前工作簿目录查找)
|
||
'
|
||
' 输出:
|
||
' Workbook - BOM库工作簿
|
||
'
|
||
' 逻辑:
|
||
' 1. 获取当前工作簿路径
|
||
' 2. 构建BOM库文件路径
|
||
' 3. 打开BOM库文件(只读模式)
|
||
' ------------------------------------------------------------------------------
|
||
Private Function OpenBOMLibrary() As Workbook
|
||
On Error GoTo ErrorHandler
|
||
|
||
' 获取当前工作簿路径
|
||
Dim currentPath As String
|
||
currentPath = ActiveWorkbook.Path
|
||
|
||
' 构建BOM库文件路径
|
||
Dim bomPath As String
|
||
bomPath = currentPath & "\" & BOMLIB_FILENAME
|
||
|
||
' 检查文件是否存在
|
||
Dim fso As Object
|
||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||
|
||
If Not fso.FileExists(bomPath) Then
|
||
Set OpenBOMLibrary = Nothing
|
||
Exit Function
|
||
End If
|
||
|
||
' 打开BOM库文件(只读)
|
||
Set OpenBOMLibrary = Workbooks.Open(bomPath, ReadOnly:=True)
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
Set OpenBOMLibrary = Nothing
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 检查工作表是否存在
|
||
'
|
||
' 输入:
|
||
' sheetName - 工作表名称
|
||
'
|
||
' 输出:
|
||
' Boolean - True表示工作表存在,False表示不存在
|
||
' ------------------------------------------------------------------------------
|
||
Private Function WorksheetExists(ByVal sheetName As String) As Boolean
|
||
On Error Resume Next
|
||
Dim ws As Worksheet
|
||
Set ws = ThisWorkbook.Sheets(sheetName)
|
||
WorksheetExists = Not ws Is Nothing
|
||
On Error GoTo 0
|
||
End Function |