From 24a54bd1eab760e3b1f17711c8f15dafb023de23 Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Tue, 24 Feb 2026 14:28:24 +0800 Subject: [PATCH] feat: add production order number column to BOM extraction output MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Add 生产订单号 as the first column in output (13 columns total) - Read production order number from column A of input worksheet - Only display production order number on first row for each product model - Set material code column to text format to preserve leading zeros - Update OutputColumns enum indices in M04_Config.bas - Update ReadInputModels to return 2 columns (order number + model) - Update ProcessSingleModel, GenerateMaterialRow, GenerateErrorRow signatures - Update WriteExtractionResults to write 13 columns with text formatting Co-Authored-By: Claude Sonnet 4.5 --- VBA_BOMConverter/Modules/M04_Config.bas | 25 +-- VBA_BOMConverter/Modules/M09_BOMExtractor.bas | 151 +++++++++++------- 2 files changed, 104 insertions(+), 72 deletions(-) diff --git a/VBA_BOMConverter/Modules/M04_Config.bas b/VBA_BOMConverter/Modules/M04_Config.bas index 71d5852..cf0fd24 100644 --- a/VBA_BOMConverter/Modules/M04_Config.bas +++ b/VBA_BOMConverter/Modules/M04_Config.bas @@ -28,18 +28,19 @@ Public Const INPUT_COL_PRODUCT_MODEL As String = "产品型号" ' 输出列枚举 Public Enum OutputColumns - oc_OriginalModel = 1 ' 原始产品型号 - oc_Azxs = 2 ' 安装形式 - oc_Bkxs = 3 ' 表壳形式 - oc_Gclj = 4 ' 过程连接 - oc_Jycz = 5 ' 接液材质 - oc_Lcfw = 6 ' 量程范围 - oc_Fjgn = 7 ' 附加功能 - oc_MaterialType = 8 ' 物料类型 - oc_MaterialName = 9 ' 物料名称 - oc_MaterialCode = 10 ' 物料编码 - oc_MaterialQty = 11 ' 物料数量 - oc_Remarks = 12 ' 提取备注 + oc_ProductionOrderNo = 1 ' 生产订单号 + oc_OriginalModel = 2 ' 原始产品型号 + oc_Azxs = 3 ' 安装形式 + oc_Bkxs = 4 ' 表壳形式 + oc_Gclj = 5 ' 过程连接 + oc_Jycz = 6 ' 接液材质 + oc_Lcfw = 7 ' 量程范围 + oc_Fjgn = 8 ' 附加功能 + oc_MaterialType = 9 ' 物料类型 + oc_MaterialName = 10 ' 物料名称 + oc_MaterialCode = 11 ' 物料编码 + oc_MaterialQty = 12 ' 物料数量 + oc_Remarks = 13 ' 提取备注 End Enum ' 型号解析常量 diff --git a/VBA_BOMConverter/Modules/M09_BOMExtractor.bas b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas index dd8538b..88b5f62 100644 --- a/VBA_BOMConverter/Modules/M09_BOMExtractor.bas +++ b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas @@ -16,7 +16,7 @@ ' ' 输出格式: ' - 纵向展开格式，每个物料一行 -' - 列: 原始产品型号, azxs, bkxs, gclj, jycz, lcfw, fjgn, +' - 列: 生产订单号, 原始产品型号, azxs, bkxs, gclj, jycz, lcfw, fjgn, ' 物料类型, 物料名称, 物料编码, 物料数量, 提取备注 ' ============================================================================== Option Explicit @@ -127,11 +127,14 @@ Public Function RunBOMExtraction() As String End If ' 处理单个型号 + Dim productionOrderNo As String Dim modelString As String - modelString = CStr(inputModels(i, 1)) + + productionOrderNo = CStr(inputModels(i, 1)) ' Column A: 生产订单号 + modelString = CStr(inputModels(i, 2)) ' Column B: 产品型号 Dim modelResults As Collection - Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger) + Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger, productionOrderNo) ' 合并结果 Dim result As Variant @@ -164,7 +167,7 @@ Public Function RunBOMExtraction() As String errorCount = 0 For Each result In allResults - If Len(CStr(result(12))) = 0 Then ' 第12列是备注 + If Len(CStr(result(13))) = 0 Then ' 第13列是备注 successCount = successCount + 1 Else errorCount = errorCount + 1 @@ -283,7 +286,7 @@ Private Function ReadInputModels(ByVal ws As Worksheet) As Variant Dim colIdx As Long colIdx = headerCell.Column - ' 查找最后一行 + ' 查找最后一行（基于产品型号列） Dim lastRow As Long lastRow = ws.Cells(ws.Rows.count, colIdx).End(xlUp).row @@ -292,8 +295,9 @@ Private Function ReadInputModels(ByVal ws As Worksheet) As Variant Exit Function End If - ' 读取数据到数组 - ReadInputModels = ws.Range(ws.Cells(2, colIdx), ws.Cells(lastRow, colIdx)).Value + ' 读取数据到数组（返回2列：生产订单号、产品型号） + ' 假设生产订单号在A列（列1），产品型号在colIdx列 + ReadInputModels = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, colIdx)).Value Exit Function ErrorHandler: @@ -321,7 +325,8 @@ End Function Private Function ProcessSingleModel( _ ByVal modelString As String, _ ByVal bomWb As Workbook, _ - ByVal logger As clsErrorLogger _ + ByVal logger As clsErrorLogger, _ + ByVal productionOrderNo As String _ ) As Collection On Error GoTo ErrorHandler @@ -335,7 +340,7 @@ Private Function ProcessSingleModel( _ ' 检查解析是否成功 If params.count = 0 Then ' 解析失败，添加错误行 - results.Add GenerateErrorRow(modelString, "型号解析失败：型号格式不正确或缺少必要字段") + results.Add GenerateErrorRow(modelString, "型号解析失败：型号格式不正确或缺少必要字段", productionOrderNo, True) Set ProcessSingleModel = results Exit Function End If @@ -353,16 +358,21 @@ Private Function ProcessSingleModel( _ 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) + outputRow = GenerateMaterialRow(modelString, params, mat, remarks, productionOrderNo, isFirstRow) results.Add outputRow + isFirstRow = False Next mat ' 如果没有匹配到任何物料，添加错误行 If allMaterials.count = 0 Then - results.Add GenerateErrorRow(modelString, "未匹配到任何物料") + results.Add GenerateErrorRow(modelString, "未匹配到任何物料", productionOrderNo, True) End If Set ProcessSingleModel = results @@ -374,7 +384,7 @@ ErrorHandler: "处理型号[" & modelString & "]失败: " & Err.Description, "" End If - results.Add GenerateErrorRow(modelString, "系统错误: " & Err.Description) + results.Add GenerateErrorRow(modelString, "系统错误: " & Err.Description, productionOrderNo, True) Set ProcessSingleModel = results End Function @@ -888,52 +898,64 @@ End Function ' params - 参数字典 ' material - 物料信息字典 ' remarks - 备注信息 +' productionOrderNo - 生产订单号 +' isFirstRow - 是否为第一条记录（用于控制生产订单号显示） ' ' 输出: -' Variant - 包含12列数据的数组 +' Variant - 包含13列数据的数组 ' ' 列定义: -' 1: 原始产品型号 -' 2: azxs -' 3: bkxs -' 4: gclj -' 5: jycz -' 6: lcfw -' 7: fjgn -' 8: 物料类型 -' 9: 物料名称 -' 10: 物料编码 -' 11: 物料数量 -' 12: 提取备注 +' 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 remarks As String, _ + ByVal productionOrderNo As String, _ + ByVal isFirstRow As Boolean _ ) As Variant - Dim result(1 To 12) As Variant + Dim result(1 To 13) As Variant - ' 第1列: 原始产品型号 - result(1) = modelString + ' 第1列: 生产订单号（仅第一条记录显示） + If isFirstRow Then + result(1) = productionOrderNo + Else + result(1) = "" + End If - ' 第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") + ' 第2列: 原始产品型号 + result(2) = modelString - ' 第8-11列: 物料信息 - result(8) = GetMaterialValue(material, "materialType") - result(9) = GetMaterialValue(material, "materialName") - result(10) = GetMaterialValue(material, "materialCode") - result(11) = GetMaterialValue(material, "materialQty") + ' 第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") - ' 第12列: 备注 - result(12) = remarks & " " & GetMaterialValue(material, "remarks") - result(12) = Trim(result(12)) + ' 第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 @@ -944,23 +966,28 @@ End Function ' 输入: ' modelString - 原始产品型号 ' errorMessage - 错误消息 +' productionOrderNo - 生产订单号 +' isFirstRow - 是否为第一条记录（错误行总是显示生产订单号） ' ' 输出: -' Variant - 包含12列数据的数组（仅型号和备注有值） +' Variant - 包含13列数据的数组（仅生产订单号、型号和备注有值） ' ------------------------------------------------------------------------------ Private Function GenerateErrorRow( _ ByVal modelString As String, _ - ByVal errorMessage As String _ + ByVal errorMessage As String, _ + ByVal productionOrderNo As String, _ + ByVal isFirstRow As Boolean _ ) As Variant - Dim result(1 To 12) As Variant + Dim result(1 To 13) As Variant Dim i As Long - For i = 1 To 12 + For i = 1 To 13 result(i) = "" Next i - result(1) = modelString - result(12) = "错误: " & errorMessage + result(1) = productionOrderNo + result(2) = modelString + result(13) = "错误: " & errorMessage GenerateErrorRow = result End Function @@ -1021,16 +1048,16 @@ Private Function WriteExtractionResults(ByVal results As Collection) As Workshee ' 写入表头 Dim headers As Variant - headers = Array("原始产品型号", "azxs", "bkxs", "gclj", "jycz", "lcfw", "fjgn", _ + headers = Array("生产订单号", "原始产品型号", "azxs", "bkxs", "gclj", "jycz", "lcfw", "fjgn", _ "物料类型", "物料名称", "物料编码", "物料数量", "提取备注") Dim c As Long - For c = 1 To 12 + For c = 1 To 13 ws.Cells(1, c).Value = headers(c - 1) Next c ' 格式化表头 - With ws.Range("A1:L1") + With ws.Range("A1:M1") .Font.Bold = True .Interior.Color = RGB(217, 217, 217) .HorizontalAlignment = xlCenter @@ -1038,8 +1065,12 @@ Private Function WriteExtractionResults(ByVal results As Collection) As Workshee ' 写入数据 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 12) + ReDim outputArr(1 To results.count, 1 To 13) Dim i As Long Dim result As Variant @@ -1048,15 +1079,15 @@ Private Function WriteExtractionResults(ByVal results As Collection) As Workshee result = results(i) Dim j As Long - For j = 1 To 12 + For j = 1 To 13 outputArr(i, j) = result(j) Next j Next i - ws.Range("A2").Resize(results.count, 12).Value = outputArr + ws.Range("A2").Resize(results.count, 13).Value = outputArr ' 格式化数据区域 - With ws.Range("A2:L" & (results.count + 1)) + With ws.Range("A2:M" & (results.count + 1)) .Borders.LineStyle = xlContinuous .Borders.Weight = xlThin End With @@ -1064,13 +1095,13 @@ Private Function WriteExtractionResults(ByVal results As Collection) As Workshee ' 如果有错误备注，标红；如果有警告，标黄 For i = 1 To results.count Dim remarkText As String - remarkText = CStr(outputArr(i, 12)) + remarkText = CStr(outputArr(i, 13)) If Len(remarkText) > 0 Then If InStr(remarkText, "错误") > 0 Then - ws.Cells(i + 1, 12).Interior.Color = RGB(255, 200, 200) + ws.Cells(i + 1, 13).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) + ws.Cells(i + 1, 13).Interior.Color = RGB(255, 255, 200) End If End If Next i