refactor(BIP): skip invalid orders and remove remarks column

- 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 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-03-16 12:15:02 +08:00
parent 04099d25bc
commit 658f8a7160

View File

@@ -1,7 +1,6 @@
'===================================================================== '=====================================================================
' 模块名: BIPUploadModule ' 模块名: BIPUploadModule
' 功能: 处理产品订单数据提取BOM后生成[BIP上传模板]格式数据 ' 功能: 处理产品订单数据提取BOM后生成[BIP上传模板]格式数据
' 特性: [已重构] 支持仅对筛选后的数据进行处理,采用内存极速读取
'===================================================================== '=====================================================================
Option Explicit Option Explicit
@@ -79,7 +78,7 @@ Public Sub ProcessOrdersToBIP()
' 【性能核心】全量读入源数据 ' 【性能核心】全量读入源数据
Dim sourceDataArr As Variant Dim sourceDataArr As Variant
sourceDataArr = orderSheet.Range("A2:F" & lastRow).value sourceDataArr = orderSheet.Range("A2:G" & lastRow).value
' 【筛选核心】获取可见区域 ' 【筛选核心】获取可见区域
Dim visibleRange As Range Dim visibleRange As Range
@@ -101,9 +100,11 @@ Public Sub ProcessOrdersToBIP()
Dim arrIndex As Long Dim arrIndex As Long
Dim processedCount As Long Dim processedCount As Long
Dim orderCount As Long Dim orderCount As Long
Dim skippedCount As Long
processedCount = 0 processedCount = 0
orderCount = 0 orderCount = 0
skippedCount = 0
' 遍历筛选出来的可见单元格 ' 遍历筛选出来的可见单元格
For Each cell In visibleRange For Each cell In visibleRange
@@ -117,6 +118,7 @@ Public Sub ProcessOrdersToBIP()
Dim Quantity As String Dim Quantity As String
Dim productCode As String Dim productCode As String
Dim componentPriority As String Dim componentPriority As String
Dim isIssueMaterial As String
totalQueueNum = Trim(sourceDataArr(arrIndex, 1)) ' A列总排号 totalQueueNum = Trim(sourceDataArr(arrIndex, 1)) ' A列总排号
orderNumber = Trim(sourceDataArr(arrIndex, 2)) ' B列生产订单号 orderNumber = Trim(sourceDataArr(arrIndex, 2)) ' B列生产订单号
@@ -124,6 +126,13 @@ Public Sub ProcessOrdersToBIP()
Quantity = Trim(sourceDataArr(arrIndex, 4)) ' D列数量 Quantity = Trim(sourceDataArr(arrIndex, 4)) ' D列数量
productCode = Trim(sourceDataArr(arrIndex, 5)) ' E列产品编码 productCode = Trim(sourceDataArr(arrIndex, 5)) ' E列产品编码
componentPriority = Trim(sourceDataArr(arrIndex, 6)) ' F列部件优先 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 If orderNumber = "" And ProductModel = "" Then
@@ -170,7 +179,8 @@ ContinueLoop:
Application.ScreenUpdating = True Application.ScreenUpdating = True
MsgBox "处理完成!" & vbCrLf & _ MsgBox "处理完成!" & vbCrLf & _
"处理筛选订单数: " & orderCount & vbCrLf & _ "处理有效订单数: " & orderCount & vbCrLf & _
"忽略无效订单数: " & skippedCount & vbCrLf & _
"生成BIP行数: " & outputData.count & vbCrLf & _ "生成BIP行数: " & outputData.count & vbCrLf & _
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
@@ -216,13 +226,9 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
Dim parser As ProductModelParser Dim parser As ProductModelParser
Set parser = New ProductModelParser Set parser = New ProductModelParser
Dim extractNote As String
extractNote = ""
If Not parser.Parse(ProductModel) Then If Not parser.Parse(ProductModel) Then
' 解析失败,添加一行错误记录 ' 解析失败,添加一行空物料记录
extractNote = "解析失败: " & parser.ErrorMessage outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "")
outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
Exit Sub Exit Sub
End If End If
@@ -230,20 +236,10 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
Dim matchedItems As Collection Dim matchedItems As Collection
Set matchedItems = BomExtractor.ExtractBom(parser.Conditions) 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 matchedItems.count = 0 Then
' 没有匹配项,添加一行空记录 ' 没有匹配项,添加一行空物料记录
If extractNote = "" Then outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "")
extractNote = "未匹配到任何物料"
End If
outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, 1, "", extractNote)
Else Else
' 输出每个匹配的物料 ' 输出每个匹配的物料
Dim item As BomItem Dim item As BomItem
@@ -255,15 +251,6 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
Set bipRowBaseDict = CreateObject("Scripting.Dictionary") Set bipRowBaseDict = CreateObject("Scripting.Dictionary")
For Each item In matchedItems 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 开始) ' 计算实际行号:行号 = BIP 行号基数 + 组内序号 (从 1 开始)
Dim baseValue As Long Dim baseValue As Long
baseValue = item.BipRowNumberBase baseValue = item.BipRowNumberBase
@@ -279,9 +266,9 @@ Private Sub ProcessSingleOrder(orderNumber As String, _
Dim actualRowNumber As Long Dim actualRowNumber As Long
actualRowNumber = baseValue + currentIndex actualRowNumber = baseValue + currentIndex
' 创建 BIP 行数据并添加到集合 ' 创建 BIP 行数据并添加到集合 (已移除备注参数)
outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, _ outputData.Add CreateBIPRowArray(orderNumber, productCode, Quantity, _
actualRowNumber, item.Code66, itemNote) actualRowNumber, item.Code66)
lineIndex = lineIndex + 1 lineIndex = lineIndex + 1
Next item Next item
@@ -296,16 +283,14 @@ End Sub
' quantity - 生产数量 ' quantity - 生产数量
' actualRowNumber - 实际行号BIP 行号基数 + 组内序号) ' actualRowNumber - 实际行号BIP 行号基数 + 组内序号)
' materialCode - 材料编码66 编码) ' materialCode - 材料编码66 编码)
' note - 备注
' 返回Variant() - 包含 10 个元素的数组 ' 返回Variant() - 包含 10 个元素的数组
'===================================================================== '=====================================================================
Private Function CreateBIPRowArray(orderNumber As String, _ Private Function CreateBIPRowArray(orderNumber As String, _
productCode As String, _ productCode As String, _
Quantity As String, _ Quantity As String, _
actualRowNumber As Long, _ actualRowNumber As Long, _
materialCode As String, _ materialCode As String) As Variant()
note As String) As Variant() Dim rowData(1 To 9) As Variant
Dim rowData(1 To 10) As Variant
rowData(1) = orderNumber ' 来源单据号(生产订单号) rowData(1) = orderNumber ' 来源单据号(生产订单号)
rowData(2) = productCode ' 产品编码 rowData(2) = productCode ' 产品编码
@@ -316,7 +301,6 @@ Private Function CreateBIPRowArray(orderNumber As String, _
rowData(7) = Date ' 需用日期(当天日期) rowData(7) = Date ' 需用日期(当天日期)
rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织(固定值) rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织(固定值)
rowData(9) = Quantity ' 计划出库数量(与生产数量一致) rowData(9) = Quantity ' 计划出库数量(与生产数量一致)
rowData(10) = note ' 备注
CreateBIPRowArray = rowData CreateBIPRowArray = rowData
End Function End Function
@@ -338,7 +322,7 @@ Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
rowCount = outputData.count rowCount = outputData.count
Dim resultData() As Variant Dim resultData() As Variant
ReDim resultData(1 To rowCount, 1 To 10) ReDim resultData(1 To rowCount, 1 To 9)
' 填充数据到二维数组 ' 填充数据到二维数组
Dim i As Long Dim i As Long
@@ -356,11 +340,10 @@ Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
resultData(i, 7) = rowArray(7) resultData(i, 7) = rowArray(7)
resultData(i, 8) = rowArray(8) resultData(i, 8) = rowArray(8)
resultData(i, 9) = rowArray(9) resultData(i, 9) = rowArray(9)
resultData(i, 10) = rowArray(10)
Next i Next i
' 一次性写入工作表从第2行开始 ' 一次性写入工作表从第2行开始
ws.Range("A2").Resize(rowCount, 10).value = resultData ws.Range("A2").Resize(rowCount, 9).value = resultData
End Sub End Sub
'===================================================================== '=====================================================================
@@ -379,7 +362,6 @@ Private Sub WriteBIPHeader(ws As Worksheet)
ws.Cells(1, 7).value = "需用日期" ws.Cells(1, 7).value = "需用日期"
ws.Cells(1, 8).value = "发料组织" ws.Cells(1, 8).value = "发料组织"
ws.Cells(1, 9).value = "计划出库数量" ws.Cells(1, 9).value = "计划出库数量"
ws.Cells(1, 10).value = "备注"
End Sub End Sub
'===================================================================== '=====================================================================