45d1c1780f
All checks were successful
NTFY Notification / notify (push) Successful in 11s
Standardize all VBA property and method names to lowercase for consistent code style: - Err object: Err.Description → err.Description, Err.Number → err.Number - Collection properties: .Count → .count - Range properties: .Rows.Count → .Rows.count, .Row → .row - Dictionary methods: .Keys → .keys, .Exists → .exists - Worksheet properties: .Sheets.Count → .Sheets.count - Fix typo: Thisworkbook.Path → ThisWorkbook.Path VBA is case-insensitive, but consistent lowercase convention improves readability. Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
1695 lines
56 KiB
QBasic
1695 lines
56 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
|
||
|
||
' 初始化部件处理器（带库存校验）- 现存量在主工作簿中
|
||
Dim invWorkbook As Workbook
|
||
Set invWorkbook = ThisWorkbook ' 现存量在主工作簿中
|
||
M08_ComponentProcessor.InitComponentProcessorWithInventory g_Logger, invWorkbook
|
||
|
||
' 初始化映射器（新增）
|
||
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 "", "M09.RunBOMExtraction", "MappingTableMissing", _
|
||
"未找到对照表工作表，azxs和lcfw将仅使用原始值匹配", ""
|
||
End If
|
||
End If
|
||
|
||
' 步骤4: 处理每个产品型号
|
||
Application.StatusBar = "正在处理产品型号..."
|
||
|
||
Dim allResults As Collection
|
||
Set allResults = New Collection
|
||
|
||
' 产品编码映射（用于BIP上传工作表生成）
|
||
Dim productCodeMap As Object
|
||
Set productCodeMap = CreateObject("Scripting.Dictionary")
|
||
|
||
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 productionOrderNo As String
|
||
Dim modelString As String
|
||
Dim orderQty As Long
|
||
Dim productCode As String
|
||
|
||
productionOrderNo = CStr(inputModels(i, 1)) ' Column A: 生产订单号
|
||
modelString = CStr(inputModels(i, 2)) ' Column B: 产品型号
|
||
orderQty = CLng(inputModels(i, 3)) ' Column C: 数量
|
||
productCode = CStr(inputModels(i, 4)) ' Column D: 产品编码
|
||
|
||
' 存储产品编码映射（用于BIP上传）
|
||
If Not productCodeMap.Exists(productionOrderNo) Then
|
||
productCodeMap.Add productionOrderNo, productCode
|
||
End If
|
||
|
||
Dim modelResults As Collection
|
||
Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger, productionOrderNo, orderQty)
|
||
|
||
' 合并结果
|
||
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)
|
||
|
||
' 步骤5.5: 生成BIP上传工作表
|
||
Application.StatusBar = "正在生成BIP上传数据..."
|
||
|
||
Dim wsBIPUpload As Worksheet
|
||
Set wsBIPUpload = WriteBIPUploadResults(allResults, inputModels, productCodeMap)
|
||
|
||
If wsBIPUpload Is Nothing Then
|
||
RunBOMExtraction = "错误：无法生成BIP上传工作表。"
|
||
GoTo ExitHandler
|
||
End If
|
||
|
||
' 步骤5.6: 生成库存比对工作表
|
||
Application.StatusBar = "正在生成库存比对数据..."
|
||
|
||
Dim wsInventoryCompare As Worksheet
|
||
Set wsInventoryCompare = WriteInventoryComparisonResults(allResults, inputModels)
|
||
|
||
If wsInventoryCompare Is Nothing Then
|
||
RunBOMExtraction = "错误：无法生成库存比对工作表。"
|
||
GoTo ExitHandler
|
||
End If
|
||
|
||
' 步骤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(13))) = 0 Then ' 第13列是备注
|
||
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 & vbCrLf & _
|
||
"已生成库存比对工作表"
|
||
|
||
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
|
||
|
||
' 读取数据到数组（返回4列：生产订单号、产品型号、数量、产品编码）
|
||
' 假设：A列(1)=生产订单号, B列(2)=产品型号, C列(3)=数量, D列(4)=产品编码
|
||
ReadInputModels = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 4)).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, _
|
||
ByVal productionOrderNo As String, _
|
||
ByVal orderQty As Long _
|
||
) 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, "型号解析失败：型号格式不正确或缺少必要字段", productionOrderNo, True)
|
||
Set ProcessSingleModel = results
|
||
Exit Function
|
||
End If
|
||
|
||
' 步骤2: 匹配所有物料类型（两阶段）
|
||
Dim allMaterials As Collection
|
||
Dim validation As Object
|
||
Set allMaterials = MatchAllMaterialTypesWithValidation(params, bomWb, logger, orderQty, productionOrderNo, validation)
|
||
|
||
' 步骤3: 生成输出行
|
||
Dim remarks As String
|
||
remarks = ""
|
||
|
||
If Not validation("valid") Then
|
||
remarks = validation("message")
|
||
End If
|
||
|
||
' 生成物料行（第一条显示生产订单号，其余不显示）
|
||
Dim isFirstRow As Boolean
|
||
isFirstRow = True
|
||
|
||
Dim mat As Variant
|
||
For Each mat In allMaterials
|
||
Dim outputRow As Variant
|
||
outputRow = GenerateMaterialRow(modelString, params, mat, remarks, productionOrderNo, isFirstRow)
|
||
results.Add outputRow
|
||
isFirstRow = False
|
||
Next mat
|
||
|
||
' 如果没有匹配到任何物料，添加错误行
|
||
If allMaterials.count = 0 Then
|
||
results.Add GenerateErrorRow(modelString, "未匹配到任何物料", productionOrderNo, True)
|
||
End If
|
||
|
||
Set ProcessSingleModel = results
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
If Not logger Is Nothing Then
|
||
logger.Record productionOrderNo, "M09.ProcessSingleModel", "SystemError", _
|
||
"处理型号[" & modelString & "]失败: " & err.Description, ""
|
||
End If
|
||
|
||
results.Add GenerateErrorRow(modelString, "系统错误: " & err.Description, productionOrderNo, True)
|
||
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, _
|
||
ByVal orderQty As Long, _
|
||
ByVal productionOrderNo As String, _
|
||
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), orderQty, productionOrderNo)
|
||
|
||
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("rowCount") > 0 Then
|
||
' 步骤1: 构建表头映射（只需构建一次）
|
||
Dim headerMap As Object
|
||
Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(ws)
|
||
|
||
' 步骤2: 遍历所有匹配行
|
||
Dim i As Long
|
||
Dim rowNum As Long
|
||
For i = 1 To bomMatchResult("rowCount")
|
||
rowNum = bomMatchResult("rowNums")(i)
|
||
Debug.Print " -> 处理匹配行 " & i & "/" & bomMatchResult("rowCount") & ": 行号=" & rowNum
|
||
|
||
' 步骤3: 提取物料信息
|
||
Dim materialInfo As Object
|
||
Set materialInfo = M07_BOMMatcher.ExtractMaterialInfo(ws, rowNum, headerMap)
|
||
|
||
If Not materialInfo Is Nothing Then
|
||
matchResult("materials").Add materialInfo
|
||
Debug.Print " 已添加: 名称=[" & materialInfo("materialName") & "] 编码=[" & materialInfo("materialCode") & "]"
|
||
Else
|
||
Debug.Print " ERROR: materialInfo为Nothing"
|
||
End If
|
||
Next i
|
||
|
||
Debug.Print " -> 共添加 " & matchResult("materials").count & " 个物料"
|
||
End If
|
||
End If
|
||
|
||
' 将匹配结果存入字典
|
||
resultsDict.Add sheetName, matchResult
|
||
Debug.Print ""
|
||
Next ws
|
||
|
||
' ========================================
|
||
' Phase 2: 统一验证所有匹配结果
|
||
' ========================================
|
||
Dim validationResult As Object
|
||
Set validationResult = ValidateAllMatchResults(resultsDict, logger, params, productionOrderNo)
|
||
|
||
' ========================================
|
||
' 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 productionOrderNo, "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, _
|
||
ByVal productionOrderNo As String _
|
||
) 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 productionOrderNo, "M09.ValidateAllMatchResults", "BOMMatchError", CStr(err), ""
|
||
Next err
|
||
|
||
Dim warn As Variant
|
||
For Each warn In warnings
|
||
logger.RecordWarning productionOrderNo, "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 productionOrderNo, "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 - 备注信息
|
||
' productionOrderNo - 生产订单号
|
||
' isFirstRow - 是否为第一条记录（用于控制生产订单号显示）
|
||
'
|
||
' 输出:
|
||
' Variant - 包含13列数据的数组
|
||
'
|
||
' 列定义:
|
||
' 1: 生产订单号（仅第一条记录显示）
|
||
' 2: 原始产品型号
|
||
' 3: azxs
|
||
' 4: bkxs
|
||
' 5: gclj
|
||
' 6: jycz
|
||
' 7: lcfw
|
||
' 8: fjgn
|
||
' 9: 物料类型
|
||
' 10: 物料名称
|
||
' 11: 物料编码
|
||
' 12: 物料数量
|
||
' 13: 提取备注
|
||
' ------------------------------------------------------------------------------
|
||
Private Function GenerateMaterialRow( _
|
||
ByVal modelString As String, _
|
||
ByVal params As Object, _
|
||
ByVal material As Object, _
|
||
ByVal remarks As String, _
|
||
ByVal productionOrderNo As String, _
|
||
ByVal isFirstRow As Boolean _
|
||
) As Variant
|
||
Dim result(1 To 13) As Variant
|
||
|
||
' 第1列: 生产订单号（仅第一条记录显示）
|
||
If isFirstRow Then
|
||
result(1) = productionOrderNo
|
||
Else
|
||
result(1) = ""
|
||
End If
|
||
|
||
' 第2列: 原始产品型号
|
||
result(2) = modelString
|
||
|
||
' 第3-8列: 参数值
|
||
result(3) = GetParamValue(params, "azxs")
|
||
result(4) = GetParamValue(params, "bkxs")
|
||
result(5) = GetParamValue(params, "gclj")
|
||
result(6) = GetParamValue(params, "jycz")
|
||
result(7) = GetParamValue(params, "lcfw")
|
||
result(8) = GetParamValue(params, "fjgn")
|
||
|
||
' 第9-12列: 物料信息
|
||
result(9) = GetMaterialValue(material, "materialType")
|
||
result(10) = GetMaterialValue(material, "materialName")
|
||
result(11) = GetMaterialValue(material, "materialCode")
|
||
result(12) = GetMaterialValue(material, "materialQty")
|
||
|
||
' 第13列: 备注
|
||
result(13) = remarks & " " & GetMaterialValue(material, "remarks")
|
||
result(13) = Trim(result(13))
|
||
|
||
GenerateMaterialRow = result
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 生成错误行
|
||
'
|
||
' 输入:
|
||
' modelString - 原始产品型号
|
||
' errorMessage - 错误消息
|
||
' productionOrderNo - 生产订单号
|
||
' isFirstRow - 是否为第一条记录（错误行总是显示生产订单号）
|
||
'
|
||
' 输出:
|
||
' Variant - 包含13列数据的数组（仅生产订单号、型号和备注有值）
|
||
' ------------------------------------------------------------------------------
|
||
Private Function GenerateErrorRow( _
|
||
ByVal modelString As String, _
|
||
ByVal errorMessage As String, _
|
||
ByVal productionOrderNo As String, _
|
||
ByVal isFirstRow As Boolean _
|
||
) As Variant
|
||
Dim result(1 To 13) As Variant
|
||
Dim i As Long
|
||
|
||
For i = 1 To 13
|
||
result(i) = ""
|
||
Next i
|
||
|
||
result(1) = productionOrderNo
|
||
result(2) = modelString
|
||
result(13) = "错误: " & 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 13
|
||
ws.Cells(1, c).Value = headers(c - 1)
|
||
Next c
|
||
|
||
' 格式化表头
|
||
With ws.Range("A1:M1")
|
||
.Font.Bold = True
|
||
.Interior.Color = RGB(217, 217, 217)
|
||
.HorizontalAlignment = xlCenter
|
||
End With
|
||
|
||
' 写入数据
|
||
If results.count > 0 Then
|
||
' 先设置物料编码列（第11列，K列）为文本格式
|
||
ws.Range("K2:K" & (results.count + 1)).NumberFormat = "@"
|
||
|
||
' 准备输出数组
|
||
Dim outputArr() As Variant
|
||
ReDim outputArr(1 To results.count, 1 To 13)
|
||
|
||
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 13
|
||
outputArr(i, j) = result(j)
|
||
Next j
|
||
Next i
|
||
|
||
ws.Range("A2").Resize(results.count, 13).Value = outputArr
|
||
|
||
' 格式化数据区域
|
||
With ws.Range("A2:M" & (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, 13))
|
||
|
||
If Len(remarkText) > 0 Then
|
||
If InStr(remarkText, "错误") > 0 Then
|
||
ws.Cells(i + 1, 13).Interior.Color = RGB(255, 200, 200)
|
||
ElseIf InStr(remarkText, "警告") > 0 Or InStr(remarkText, "已忽略") > 0 Then
|
||
ws.Cells(i + 1, 13).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
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 写入BIP上传数据到工作表
|
||
'
|
||
' 输入:
|
||
' results - 提取结果集合（来自BOM提取结果）
|
||
' inputModels - 输入数据数组（包含订单号、型号、数量、产品编码）
|
||
' productCodeMap - 产品编码映射字典（订单号 -> 产品编码）
|
||
'
|
||
' 输出:
|
||
' Worksheet - BIP上传工作表
|
||
'
|
||
' 逻辑:
|
||
' 1. 创建或清空"BIP上传"工作表
|
||
' 2. 写入表头（9列）
|
||
' 3. 构建输出数据：
|
||
' - 检测订单号变化（重置物料行号计数器）
|
||
' - 生成行号：7000 + 物料流水号（1, 2, 3...）
|
||
' - 查找产品编码和订单数量
|
||
' - 提取物料编码和数量
|
||
' - 填充固定值字段
|
||
' 4. 批量写入数据
|
||
' 5. 格式化工作表（边框、列宽、数字格式）
|
||
'
|
||
' 输出格式（9列）:
|
||
' 1: 来源单据号（生产订单号）
|
||
' 2: 产品编码
|
||
' 3: 生产数量（订单数量×物料数量）
|
||
' 4: 行号（7000 + 流水号）
|
||
' 5: 材料编码
|
||
' 6: 供应方式（固定值："一般发料"）
|
||
' 7: 需用日期（当前日期，格式：yyyy/m/d）
|
||
' 8: 发料组织（固定值："重庆布莱迪仪器仪表有限公司"）
|
||
' 9: 计划出库数量（与生产数量相同）
|
||
' ------------------------------------------------------------------------------
|
||
Private Function WriteBIPUploadResults( _
|
||
ByVal results As Collection, _
|
||
ByVal inputModels As Variant, _
|
||
ByVal productCodeMap As Object _
|
||
) As Worksheet
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim ws As Worksheet
|
||
|
||
' 创建或获取工作表
|
||
On Error Resume Next
|
||
Set ws = ThisWorkbook.Sheets(BIP_UPLOAD_SHEET_NAME)
|
||
On Error GoTo ErrorHandler
|
||
|
||
If ws Is Nothing Then
|
||
Set ws = ThisWorkbook.Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.count))
|
||
ws.Name = BIP_UPLOAD_SHEET_NAME
|
||
Else
|
||
ws.Cells.Clear
|
||
End If
|
||
|
||
' 写入表头（9列）
|
||
Dim headers As Variant
|
||
headers = Array("来源单据号（生产订单号）", "产品编码", "生产数量", "行号", "材料编码", _
|
||
"供应方式", "需用日期", "发料组织", "计划出库数量")
|
||
|
||
Dim c As Long
|
||
For c = 1 To 9
|
||
ws.Cells(1, c).Value = headers(c - 1)
|
||
Next c
|
||
|
||
' 格式化表头
|
||
With ws.Range("A1:I1")
|
||
.Font.Bold = True
|
||
.Interior.Color = RGB(217, 217, 217)
|
||
.HorizontalAlignment = xlCenter
|
||
End With
|
||
|
||
' 写入数据
|
||
If results.count > 0 Then
|
||
' 先设置材料编码列（第5列，E列）为文本格式
|
||
ws.Range("E2:E" & (results.count + 1)).NumberFormat = "@"
|
||
|
||
' 准备输出数组
|
||
Dim outputArr() As Variant
|
||
ReDim outputArr(1 To results.count, 1 To 9)
|
||
|
||
' 行号生成变量
|
||
Dim currentOrderNo As String
|
||
Dim materialSeqNum As Long
|
||
materialSeqNum = 0
|
||
currentOrderNo = ""
|
||
|
||
Dim i As Long
|
||
Dim result As Variant
|
||
|
||
For i = 1 To results.count
|
||
result = results(i)
|
||
|
||
' 提取订单号（注意：result(1)在非第一行时为空，需要从第2列获取原始型号来判断）
|
||
Dim resultOrderNo As String
|
||
Dim resultModel As String
|
||
resultOrderNo = CStr(result(1)) ' 第1列：生产订单号（仅第一条记录有值）
|
||
resultModel = CStr(result(2)) ' 第2列：原始产品型号
|
||
|
||
' 检测新订单，重置计数器
|
||
' 如果resultOrderNo不为空，说明是新订单的第一条记录
|
||
If Len(Trim(resultOrderNo)) > 0 And resultOrderNo <> currentOrderNo Then
|
||
currentOrderNo = resultOrderNo
|
||
materialSeqNum = 0
|
||
End If
|
||
|
||
' 行号计数器递增
|
||
materialSeqNum = materialSeqNum + 1
|
||
|
||
' 生成行号：7000 + 流水号
|
||
Dim bipRowNum As Long
|
||
bipRowNum = BIP_ROW_NUMBER_BASE + materialSeqNum
|
||
|
||
' 查找产品编码（使用currentOrderNo）
|
||
Dim currentProductCode As String
|
||
If productCodeMap.Exists(currentOrderNo) Then
|
||
currentProductCode = CStr(productCodeMap(currentOrderNo))
|
||
Else
|
||
currentProductCode = ""
|
||
End If
|
||
|
||
' 【新增】查找订单数量（使用currentOrderNo）
|
||
Dim currentOrderQty As Long
|
||
currentOrderQty = 1 ' 默认值
|
||
|
||
' 遍历inputModels查找订单数量
|
||
Dim j As Long
|
||
For j = LBound(inputModels, 1) To UBound(inputModels, 1)
|
||
If CStr(inputModels(j, 1)) = currentOrderNo Then
|
||
currentOrderQty = CLng(inputModels(j, 3)) ' 第3列是订单数量
|
||
Exit For
|
||
End If
|
||
Next j
|
||
|
||
' 提取物料编码和BOM库基础数量
|
||
Dim materialCode As String
|
||
Dim bomQty As Long
|
||
Dim finalQty As Long
|
||
Dim isErrorRow As Boolean
|
||
|
||
materialCode = CStr(result(11)) ' 第11列：物料编码
|
||
|
||
' 检查是否为错误行（物料编码为空）
|
||
isErrorRow = (Len(Trim(materialCode)) = 0)
|
||
|
||
' 第12列：BOM库基础数量（需要乘以订单数量）
|
||
If Not isErrorRow Then
|
||
bomQty = CLng(result(12))
|
||
Else
|
||
bomQty = 0
|
||
End If
|
||
|
||
' 【新增】计算最终数量 = 订单数量 × BOM数量
|
||
finalQty = bomQty * currentOrderQty
|
||
|
||
' 填充输出数组（使用currentOrderNo确保每一行都有订单号）
|
||
outputArr(i, 1) = currentOrderNo ' 来源单据号（生产订单号）
|
||
outputArr(i, 2) = currentProductCode ' 产品编码
|
||
outputArr(i, 3) = finalQty ' 生产数量 = 订单数量 × BOM数量
|
||
outputArr(i, 4) = bipRowNum ' 行号
|
||
outputArr(i, 5) = materialCode ' 材料编码
|
||
outputArr(i, 6) = BIP_SUPPLY_MODE ' 供应方式
|
||
outputArr(i, 7) = Format(Date, "yyyy/m/d") ' 需用日期
|
||
outputArr(i, 8) = BIP_ISSUE_ORG ' 发料组织
|
||
outputArr(i, 9) = finalQty ' 计划出库数量 = 订单数量 × BOM数量
|
||
Next i
|
||
|
||
' 批量写入数据
|
||
ws.Range("A2").Resize(results.count, 9).Value = outputArr
|
||
|
||
' 格式化数据区域
|
||
With ws.Range("A2:I" & (results.count + 1))
|
||
.Borders.LineStyle = xlContinuous
|
||
.Borders.Weight = xlThin
|
||
End With
|
||
|
||
' 设置列宽
|
||
ws.Columns("A").ColumnWidth = 15 ' 来源单据号
|
||
ws.Columns("B").ColumnWidth = 15 ' 产品编码
|
||
ws.Columns("C").ColumnWidth = 10 ' 生产数量
|
||
ws.Columns("D").ColumnWidth = 8 ' 行号
|
||
ws.Columns("E").ColumnWidth = 15 ' 材料编码
|
||
ws.Columns("F").ColumnWidth = 12 ' 供应方式
|
||
ws.Columns("G").ColumnWidth = 12 ' 需用日期
|
||
ws.Columns("H").ColumnWidth = 25 ' 发料组织
|
||
ws.Columns("I").ColumnWidth = 12 ' 计划出库数量
|
||
|
||
' 冻结首行
|
||
ws.Activate
|
||
ActiveWindow.FreezePanes = False
|
||
ws.Rows(2).Select
|
||
ActiveWindow.FreezePanes = True
|
||
ws.Cells(1, 1).Select
|
||
End If
|
||
|
||
Set WriteBIPUploadResults = ws
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
Set WriteBIPUploadResults = Nothing
|
||
End Function
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 写入库存比对数据到工作表
|
||
'
|
||
' 输入:
|
||
' results - 提取结果集合（来自BOM提取结果）
|
||
' inputModels - 输入数据数组（包含订单号、型号、数量、产品编码）
|
||
'
|
||
' 输出:
|
||
' Worksheet - 库存比对工作表
|
||
'
|
||
' 逻辑:
|
||
' 1. 创建或清空"库存比对"工作表
|
||
' 2. 写入表头（7列）
|
||
' 3. 遍历results，筛选materialType="部件"的物料
|
||
' 4. 对每个部件物料：
|
||
' a. 查找订单数量
|
||
' b. 调用M08_ComponentProcessor.GetComponentInventoryInfo()
|
||
' c. 计算序号
|
||
' d. 填充行数据
|
||
' 5. 批量写入数据
|
||
' 6. 格式化工作表（边框、列宽）
|
||
'
|
||
' 输出格式（7列）:
|
||
' 1: 序号（10+0, 10+1, 20+0, 20+1...）
|
||
' 2: 生产订单号
|
||
' 3: 物料编码
|
||
' 4: 物料名称
|
||
' 5: 所需数量（订单数量 × BOM数量）
|
||
' 6: 库存数量
|
||
' 7: 库存充足（"是"/"否"）
|
||
' ------------------------------------------------------------------------------
|
||
Private Function WriteInventoryComparisonResults( _
|
||
ByVal results As Collection, _
|
||
ByVal inputModels As Variant _
|
||
) As Worksheet
|
||
On Error GoTo ErrorHandler
|
||
|
||
Dim ws As Worksheet
|
||
Dim headers As Variant
|
||
Dim c As Long
|
||
Dim modelToOrderMap As Object
|
||
Dim i As Long
|
||
Dim j As Long
|
||
Dim result As Variant
|
||
Dim OrderNo As String
|
||
Dim modelStr As String
|
||
Dim componentResults As Collection
|
||
Dim materialType As String
|
||
Dim outputArr() As Variant
|
||
Dim baseSeqNum As Long
|
||
Dim materialSeqNum As Long
|
||
Dim currentOrderNo As String
|
||
Dim prevOrderNo As String
|
||
Dim resultOrderNo As String
|
||
Dim finalSeqNum As Long
|
||
Dim orderQty As Long
|
||
Dim materialCode As String
|
||
Dim materialName As String
|
||
Dim bomQty As Long
|
||
Dim invInfo As Object
|
||
Dim stockQty As Long
|
||
Dim isSufficientStr As String
|
||
Dim requiredQty As Long
|
||
Dim suffStatus As String
|
||
|
||
' 创建或获取工作表
|
||
On Error Resume Next
|
||
Set ws = ThisWorkbook.Sheets(INVENTORY_COMPARISON_SHEET_NAME)
|
||
On Error GoTo ErrorHandler
|
||
|
||
If ws Is Nothing Then
|
||
Set ws = ThisWorkbook.Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.count))
|
||
ws.Name = INVENTORY_COMPARISON_SHEET_NAME
|
||
Else
|
||
ws.Cells.Clear
|
||
End If
|
||
|
||
' 写入表头（7列）
|
||
headers = Array("序号", "生产订单号", "物料编码", "物料名称", "所需数量", "库存数量", "库存充足")
|
||
|
||
For c = 1 To 7
|
||
ws.Cells(1, c).Value = headers(c - 1)
|
||
Next c
|
||
|
||
' 格式化表头
|
||
With ws.Range("A1:G1")
|
||
.Font.Bold = True
|
||
.Interior.Color = RGB(217, 217, 217)
|
||
.HorizontalAlignment = xlCenter
|
||
End With
|
||
|
||
' ========================================
|
||
' 步骤1: 构建产品型号 → 生产订单号的映射
|
||
' ========================================
|
||
' 在BOM提取结果中，result(1)（生产订单号）仅第一行有值，
|
||
' 但result(2)（原始产品型号）每行都有值
|
||
' 因此需要建立映射：产品型号 → 生产订单号
|
||
|
||
Set modelToOrderMap = CreateObject("Scripting.Dictionary")
|
||
|
||
For i = 1 To results.count
|
||
result = results(i)
|
||
|
||
OrderNo = CStr(result(1)) ' 第1列：生产订单号
|
||
modelStr = CStr(result(2)) ' 第2列：原始产品型号
|
||
|
||
' 仅当订单号不为空时，添加映射
|
||
If Len(Trim(OrderNo)) > 0 And Len(Trim(modelStr)) > 0 Then
|
||
If Not modelToOrderMap.Exists(modelStr) Then
|
||
modelToOrderMap.Add modelStr, OrderNo
|
||
End If
|
||
End If
|
||
Next i
|
||
|
||
' ========================================
|
||
' 步骤2: 筛选"部件"类型物料
|
||
' ========================================
|
||
Set componentResults = New Collection
|
||
|
||
For i = 1 To results.count
|
||
result = results(i)
|
||
|
||
' 第9列是物料类型
|
||
materialType = CStr(result(9))
|
||
|
||
' 仅处理"部件"类型
|
||
If materialType = "部件" Then
|
||
componentResults.Add result
|
||
End If
|
||
Next i
|
||
|
||
' 写入数据
|
||
If componentResults.count > 0 Then
|
||
' 先设置物料编码列（第3列，C列）为文本格式
|
||
ws.Range("C2:C" & (componentResults.count + 1)).NumberFormat = "@"
|
||
|
||
' 准备输出数组
|
||
ReDim outputArr(1 To componentResults.count, 1 To 7)
|
||
|
||
' 序号生成变量
|
||
baseSeqNum = 0
|
||
materialSeqNum = 0
|
||
currentOrderNo = ""
|
||
prevOrderNo = ""
|
||
|
||
' ========================================
|
||
' 步骤3: 写入库存比对数据
|
||
' ========================================
|
||
For i = 1 To componentResults.count
|
||
result = componentResults(i)
|
||
|
||
' 【关键修复】从映射表中获取订单号
|
||
modelStr = CStr(result(2)) ' 第2列：原始产品型号
|
||
|
||
If modelToOrderMap.Exists(modelStr) Then
|
||
resultOrderNo = CStr(modelToOrderMap(modelStr))
|
||
Else
|
||
resultOrderNo = ""
|
||
End If
|
||
|
||
' 检测新订单
|
||
If resultOrderNo <> prevOrderNo And Len(Trim(resultOrderNo)) > 0 Then
|
||
prevOrderNo = resultOrderNo
|
||
currentOrderNo = resultOrderNo
|
||
baseSeqNum = baseSeqNum + 10
|
||
materialSeqNum = 0
|
||
End If
|
||
|
||
' 计算序号：基数 + 物料序号
|
||
finalSeqNum = baseSeqNum + materialSeqNum
|
||
materialSeqNum = materialSeqNum + 1
|
||
|
||
' 查找订单数量（使用currentOrderNo）
|
||
orderQty = 1 ' 默认值
|
||
|
||
For j = LBound(inputModels, 1) To UBound(inputModels, 1)
|
||
If CStr(inputModels(j, 1)) = currentOrderNo Then
|
||
orderQty = CLng(inputModels(j, 3)) ' 第3列是订单数量
|
||
Exit For
|
||
End If
|
||
Next j
|
||
|
||
' 提取物料信息
|
||
materialCode = CStr(result(11)) ' 第11列：物料编码
|
||
materialName = CStr(result(10)) ' 第10列：物料名称
|
||
|
||
' 第12列：BOM库基础数量
|
||
If IsNumeric(result(12)) Then
|
||
bomQty = CLng(result(12))
|
||
Else
|
||
bomQty = 1
|
||
End If
|
||
|
||
' 获取库存信息
|
||
Set invInfo = M08_ComponentProcessor.GetComponentInventoryInfo( _
|
||
materialCode, bomQty, orderQty)
|
||
|
||
' 提取库存数据
|
||
stockQty = invInfo("stockQty")
|
||
isSufficientStr = IIf(invInfo("isSufficient"), "是", "否")
|
||
|
||
' 计算所需数量
|
||
requiredQty = orderQty * bomQty
|
||
|
||
' 填充输出数组
|
||
outputArr(i, 1) = finalSeqNum ' 序号
|
||
outputArr(i, 2) = currentOrderNo ' 【关键修复】生产订单号
|
||
outputArr(i, 3) = materialCode ' 物料编码
|
||
outputArr(i, 4) = materialName ' 物料名称
|
||
outputArr(i, 5) = requiredQty ' 所需数量
|
||
outputArr(i, 6) = stockQty ' 库存数量
|
||
outputArr(i, 7) = isSufficientStr ' 库存充足
|
||
Next i
|
||
|
||
' 批量写入数据
|
||
ws.Range("A2").Resize(componentResults.count, 7).Value = outputArr
|
||
|
||
' 格式化数据区域
|
||
With ws.Range("A2:G" & (componentResults.count + 1))
|
||
.Borders.LineStyle = xlContinuous
|
||
.Borders.Weight = xlThin
|
||
End With
|
||
|
||
' 根据库存状态设置背景色
|
||
For i = 1 To componentResults.count
|
||
suffStatus = CStr(outputArr(i, 7))
|
||
|
||
If suffStatus = "否" Then
|
||
' 库存不足，标记为淡红色
|
||
ws.Cells(i + 1, 7).Interior.Color = RGB(255, 200, 200)
|
||
Else
|
||
' 库存充足，标记为淡绿色
|
||
ws.Cells(i + 1, 7).Interior.Color = RGB(200, 255, 200)
|
||
End If
|
||
Next i
|
||
|
||
' 设置列宽
|
||
ws.Columns("A").ColumnWidth = 8 ' 序号
|
||
ws.Columns("B").ColumnWidth = 15 ' 生产订单号
|
||
ws.Columns("C").ColumnWidth = 15 ' 物料编码
|
||
ws.Columns("D").ColumnWidth = 30 ' 物料名称
|
||
ws.Columns("E").ColumnWidth = 10 ' 所需数量
|
||
ws.Columns("F").ColumnWidth = 10 ' 库存数量
|
||
ws.Columns("G").ColumnWidth = 10 ' 库存充足
|
||
|
||
' 冻结首行
|
||
ws.Activate
|
||
ActiveWindow.FreezePanes = False
|
||
ws.Rows(2).Select
|
||
ActiveWindow.FreezePanes = True
|
||
ws.Cells(1, 1).Select
|
||
End If
|
||
|
||
Set WriteInventoryComparisonResults = ws
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
Set WriteInventoryComparisonResults = 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 |