1d5bad86f7
All checks were successful
NTFY Notification / notify (push) Successful in 4s
Add a preprocessing step to the BOM Extraction System to enhance parameter extraction with mapping values from "对照表" worksheet. For azxs (安装形式) and lcfw (量程范围), the system now stores both the raw parsed value AND the mapped value from the lookup table, enabling flexible dual-value matching. Changes: - Create M06A_Mapper.bas: New module for value mapping - Load azxs/lcfw mappings from "对照表" worksheet - Return dual-value format "raw,mapped" (e.g., "A0,径向") - Support graceful degradation if "对照表" not found - Define constants locally to avoid VBA cross-module reference issues - Modify M06_ModelParser.bas: - Extract raw parameter values first - Apply mapping via M06A_Mapper if initialized - Store dual values for azxs and lcfw parameters - Modify M07_BOMMatcher.bas: - Update EvaluateCellCondition() to support dual-value matching - Split by comma and check if ANY value matches - Backward compatible with single-value parameters - Modify M09_BOMExtractor.bas: - Initialize M06A_Mapper during RunBOMExtraction() - Add WorksheetExists() helper function - Log warning if "对照表" worksheet not found - Define MAPPING_SHEET_NAME constant locally - Modify M04_Config.bas: - Add mapping table configuration constants - MAPPING_SHEET_NAME, MAPPING_COL_LCFW_KEY, etc. - Update CLAUDE.md: - Document new M06A_Mapper module - Update data flow diagram with mapping step - Document dual-value matching behavior - Update system architecture diagram - Update docs/RunBOMExtraction_运行机制详解.md: - Add M06A_Mapper to all diagrams and documentation - Add detailed value mapping section - Update sequence diagrams with mapping flow - Update parameter examples with dual-value format - Bump documentation version to 3.0 Example: Input: Product model "YTHN-100.A0.531.G123.M04.Y3" Parse: azxs="A0", lcfw="M04" Map: azxs="A0,径向", lcfw="M04,高压" Match: BOM库 with azxs="径向" OR "A0" → MATCH Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
1061 lines
34 KiB
QBasic
1061 lines
34 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）
|
||
' - 部件、接头、弹性元件的交叉验证
|
||
' ------------------------------------------------------------------------------
|
||
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)
|
||
|
||
' ========================================
|
||
' 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 - 错误记录器
|
||
'
|
||
' 输出:
|
||
' 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
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 生成单行输出数据
|
||
'
|
||
' 输入:
|
||
' 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 |