From 658f8a7160cc53c192e4aa434b97c95c71c753d5 Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Mon, 16 Mar 2026 12:15:02 +0800 Subject: [PATCH] refactor(BIP): skip invalid orders and remove remarks column MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Add logic to skip orders where [是否领料] = "否" - Remove remarks column from BIP output (10 columns → 9 columns) - Simplify error handling by removing detailed error notes - Update data reading range to include column G (是否领料) Co-Authored-By: Claude Sonnet 4.6 --- VBA/Modules/BIPUploadModule.bas | 64 ++++++++++++--------------------- 1 file changed, 23 insertions(+), 41 deletions(-) diff --git a/VBA/Modules/BIPUploadModule.bas b/VBA/Modules/BIPUploadModule.bas index 9bc6f13..941e286 100644 --- a/VBA/Modules/BIPUploadModule.bas +++ b/VBA/Modules/BIPUploadModule.bas @@ -1,7 +1,6 @@ '===================================================================== ' 模块名: BIPUploadModule ' 功能: 处理产品订单数据，提取BOM后生成[BIP上传模板]格式数据 -' 特性: [已重构] 支持仅对筛选后的数据进行处理，采用内存极速读取 '===================================================================== Option Explicit @@ -79,7 +78,7 @@ Public Sub ProcessOrdersToBIP() ' 【性能核心】全量读入源数据 Dim sourceDataArr As Variant - sourceDataArr = orderSheet.Range("A2:F" & lastRow).value + sourceDataArr = orderSheet.Range("A2:G" & lastRow).value ' 【筛选核心】获取可见区域 Dim visibleRange As Range @@ -101,9 +100,11 @@ Public Sub ProcessOrdersToBIP() Dim arrIndex As Long Dim processedCount As Long Dim orderCount As Long + Dim skippedCount As Long processedCount = 0 orderCount = 0 + skippedCount = 0 ' 遍历筛选出来的可见单元格 For Each cell In visibleRange @@ -117,6 +118,7 @@ Public Sub ProcessOrdersToBIP() Dim Quantity As String Dim productCode As String Dim componentPriority As String + Dim isIssueMaterial As String totalQueueNum = Trim(sourceDataArr(arrIndex, 1)) ' A列：总排号 orderNumber = Trim(sourceDataArr(arrIndex, 2)) ' B列：生产订单号 @@ -124,6 +126,13 @@ Public Sub ProcessOrdersToBIP() Quantity = Trim(sourceDataArr(arrIndex, 4)) ' D列：数量 productCode = Trim(sourceDataArr(arrIndex, 5)) ' E列：产品编码 componentPriority = Trim(sourceDataArr(arrIndex, 6)) ' F列：部件优先 + isIssueMaterial = Trim(sourceDataArr(arrIndex, 7)) ' G列：是否领料 + + ' 【拦截逻辑】忽略[是否领料]为"否"的订单 + If isIssueMaterial = "否" Then + skippedCount = skippedCount + 1 + GoTo ContinueLoop + End If ' 跳过空行 If orderNumber = "" And ProductModel = "" Then @@ -170,7 +179,8 @@ ContinueLoop: Application.ScreenUpdating = True MsgBox "处理完成!" & vbCrLf & _ - "处理筛选订单数: " & orderCount & vbCrLf & _ + "处理有效订单数: " & orderCount & vbCrLf & _ + "忽略无效订单数: " & skippedCount & vbCrLf & _ "生成BIP行数: " & outputData.count & vbCrLf & _ "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation @@ -216,13 +226,9 @@ Private Sub ProcessSingleOrder(orderNumber As String, _ Dim parser As ProductModelParser Set parser = New ProductModelParser - Dim extractNote As String - extractNote = "" - If Not parser.Parse(ProductModel) Then - ' 解析失败，添加一行错误记录 - extractNote = "解析失败: " & parser.ErrorMessage - outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote) + ' 解析失败，添加一行空物料记录 + outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "") Exit Sub End If @@ -230,20 +236,10 @@ Private Sub ProcessSingleOrder(orderNumber As String, _ Dim matchedItems As Collection Set matchedItems = BomExtractor.ExtractBom(parser.Conditions) - ' 获取错误信息 - Dim bomErrors As String - bomErrors = BomExtractor.GetErrorSummary - If bomErrors <> "" Then - extractNote = bomErrors - End If - ' 输出结果 If matchedItems.count = 0 Then - ' 没有匹配项，添加一行空记录 - If extractNote = "" Then - extractNote = "未匹配到任何物料" - End If - outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote) + ' 没有匹配项，添加一行空物料记录 + outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "") Else ' 输出每个匹配的物料 Dim item As BomItem @@ -255,15 +251,6 @@ Private Sub ProcessSingleOrder(orderNumber As String, _ Set bipRowBaseDict = CreateObject("Scripting.Dictionary") For Each item In matchedItems - Dim itemNote As String - itemNote = extractNote - - ' 添加物料特定的错误 - If item.MatchError <> "" Then - If itemNote <> "" Then itemNote = itemNote & "; " - itemNote = itemNote & item.MatchError - End If - ' 计算实际行号：行号 = BIP 行号基数 + 组内序号 (从 1 开始) Dim baseValue As Long baseValue = item.BipRowNumberBase @@ -279,9 +266,9 @@ Private Sub ProcessSingleOrder(orderNumber As String, _ Dim actualRowNumber As Long actualRowNumber = baseValue + currentIndex - ' 创建 BIP 行数据并添加到集合 + ' 创建 BIP 行数据并添加到集合 (已移除备注参数) outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, _ - actualRowNumber, item.Code66, itemNote) + actualRowNumber, item.Code66) lineIndex = lineIndex + 1 Next item @@ -296,16 +283,14 @@ End Sub ' quantity - 生产数量 ' actualRowNumber - 实际行号（BIP 行号基数 + 组内序号） ' materialCode - 材料编码（66 编码） -' note - 备注 ' 返回：Variant() - 包含 10 个元素的数组 '===================================================================== Private Function CreateBIPRowArray(orderNumber As String, _ productCode As String, _ Quantity As String, _ actualRowNumber As Long, _ - materialCode As String, _ - note As String) As Variant() - Dim rowData(1 To 10) As Variant + materialCode As String) As Variant() + Dim rowData(1 To 9) As Variant rowData(1) = orderNumber ' 来源单据号（生产订单号） rowData(2) = productCode ' 产品编码 @@ -316,7 +301,6 @@ Private Function CreateBIPRowArray(orderNumber As String, _ rowData(7) = Date ' 需用日期（当天日期） rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值） rowData(9) = Quantity ' 计划出库数量（与生产数量一致） - rowData(10) = note ' 备注 CreateBIPRowArray = rowData End Function @@ -338,7 +322,7 @@ Private Sub WriteBatchData(ws As Worksheet, outputData As Collection) rowCount = outputData.count Dim resultData() As Variant - ReDim resultData(1 To rowCount, 1 To 10) + ReDim resultData(1 To rowCount, 1 To 9) ' 填充数据到二维数组 Dim i As Long @@ -356,11 +340,10 @@ Private Sub WriteBatchData(ws As Worksheet, outputData As Collection) resultData(i, 7) = rowArray(7) resultData(i, 8) = rowArray(8) resultData(i, 9) = rowArray(9) - resultData(i, 10) = rowArray(10) Next i ' 一次性写入工作表（从第2行开始） - ws.Range("A2").Resize(rowCount, 10).value = resultData + ws.Range("A2").Resize(rowCount, 9).value = resultData End Sub '===================================================================== @@ -379,7 +362,6 @@ Private Sub WriteBIPHeader(ws As Worksheet) ws.Cells(1, 7).value = "需用日期" ws.Cells(1, 8).value = "发料组织" ws.Cells(1, 9).value = "计划出库数量" - ws.Cells(1, 10).value = "备注" End Sub '=====================================================================