feat: implement BIP upload worksheet with quantity calculation fix
All checks were successful
NTFY Notification / notify (push) Successful in 4s

This commit implements the BIP upload worksheet functionality for ERP system integration and fixes a critical bug in quantity calculation.

Changes:
1. Added BIP upload configuration constants to M04_Config.bas
   - BIP_UPLOAD_SHEET_NAME = "BIP上传"
   - BIP_ROW_NUMBER_BASE = 7000
   - BIP_SUPPLY_MODE = "一般发料"
   - BIP_ISSUE_ORG = "重庆布莱迪仪器仪表有限公司"

2. Extended input data reading to 4 columns (M09_BOMExtractor.bas)
   - Column D: Product Code (产品编码)
   - Updated ReadInputModels to read columns A:D

3. Added product code mapping in main flow
   - Created productCodeMap Dictionary to store order number -> product code mappings
   - Stored product codes during input processing loop

4. Created WriteBIPUploadResults function
   - Generates 9-column BIP upload worksheet
   - Implements row number generation (7000 + material sequence number)
   - Resets sequence counter for each new order
   - Includes all rows (including error rows)
   - Formats worksheet with borders, column widths, and freeze panes

5. **CRITICAL FIX**: Corrected quantity calculation logic
   - Added order quantity lookup from inputModels
   - Changed from: materialQty = result(12) (BOM base quantity only)
   - Changed to: finalQty = bomQty * currentOrderQty
   - Applied fix to both "生产数量" (column 3) and "计划出库数量" (column 9)
   - Updated comment to clarify result(12) is BOM base quantity

Output Format (9 columns):
1. 来源单据号 (Source Document Number) - Production Order No
2. 产品编码 (Product Code)
3. 生产数量 (Production Quantity) = Order Qty × Material Qty
4. 行号 (Row Number) = 7000 + sequence (resets per order)
5. 材料编码 (Material Code)
6. 供应方式 (Supply Mode) = "一般发料"
7. 需用日期 (Required Date) = Current date (yyyy/m/d format)
8. 发料组织 (Issue Organization) = "重庆布莱迪仪器仪表有限公司"
9. 计划出库数量 (Planned Output Qty) = Order Qty × Material Qty

Business Rules Implemented:
- Error rows are included (material code is empty, quantities are 0)
- Empty product codes are written as empty strings
- Row numbers reset to 7001 for each new order
- Material quantities are correctly calculated as order quantity × BOM quantity

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-02-26 14:41:58 +08:00
parent 44d6bdb750
commit e086dee920
2 changed files with 233 additions and 3 deletions

View File

@@ -22,6 +22,12 @@ Public Const BOMLIB_FILENAME As String = "BOM库.xlsx"
Public Const BOMLIB_START_ROW As Long = 2 ' BOM库数据起始行第1行是表头 Public Const BOMLIB_START_ROW As Long = 2 ' BOM库数据起始行第1行是表头
Public Const OUTPUT_SHEET_NAME As String = "BOM提取结果" Public Const OUTPUT_SHEET_NAME As String = "BOM提取结果"
' BIP上传工作表配置
Public Const BIP_UPLOAD_SHEET_NAME As String = "BIP上传"
Public Const BIP_ROW_NUMBER_BASE As Long = 7000
Public Const BIP_SUPPLY_MODE As String = "一般发料"
Public Const BIP_ISSUE_ORG As String = "重庆布莱迪仪器仪表有限公司"
' 输入列名称配置 ' 输入列名称配置
Public Const INPUT_COL_MODEL As String = "型号" Public Const INPUT_COL_MODEL As String = "型号"
Public Const INPUT_COL_PRODUCT_MODEL As String = "产品型号" Public Const INPUT_COL_PRODUCT_MODEL As String = "产品型号"

View File

@@ -117,6 +117,10 @@ Public Function RunBOMExtraction() As String
Dim allResults As Collection Dim allResults As Collection
Set allResults = New Collection Set allResults = New Collection
' 产品编码映射用于BIP上传工作表生成
Dim productCodeMap As Object
Set productCodeMap = CreateObject("Scripting.Dictionary")
Dim i As Long Dim i As Long
Dim totalModels As Long Dim totalModels As Long
totalModels = UBound(inputModels, 1) totalModels = UBound(inputModels, 1)
@@ -134,10 +138,17 @@ Public Function RunBOMExtraction() As String
Dim productionOrderNo As String Dim productionOrderNo As String
Dim modelString As String Dim modelString As String
Dim orderQty As Long Dim orderQty As Long
Dim productCode As String
productionOrderNo = CStr(inputModels(i, 1)) ' Column A: 生产订单号 productionOrderNo = CStr(inputModels(i, 1)) ' Column A: 生产订单号
modelString = CStr(inputModels(i, 2)) ' Column B: 产品型号 modelString = CStr(inputModels(i, 2)) ' Column B: 产品型号
orderQty = CLng(inputModels(i, 3)) ' Column C: 数量 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 Dim modelResults As Collection
Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger, productionOrderNo, orderQty) Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger, productionOrderNo, orderQty)
@@ -155,6 +166,17 @@ Public Function RunBOMExtraction() As String
Dim wsOutput As Worksheet Dim wsOutput As Worksheet
Set wsOutput = WriteExtractionResults(allResults) 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
' 步骤6: 生成错误报告 ' 步骤6: 生成错误报告
If g_Logger.HasIssues Then If g_Logger.HasIssues Then
g_Logger.PrintReport ActiveWorkbook g_Logger.PrintReport ActiveWorkbook
@@ -301,9 +323,9 @@ Private Function ReadInputModels(ByVal ws As Worksheet) As Variant
Exit Function Exit Function
End If End If
' 读取数据到数组(返回3列:生产订单号、产品型号、数量) ' 读取数据到数组(返回4列:生产订单号、产品型号、数量、产品编码
' 假设A列(1)=生产订单号, B列(2)=产品型号, C列(3)=数量 ' 假设A列(1)=生产订单号, B列(2)=产品型号, C列(3)=数量, D列(4)=产品编码
ReadInputModels = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 3)).Value ReadInputModels = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, 4)).Value
Exit Function Exit Function
ErrorHandler: ErrorHandler:
@@ -1140,6 +1162,208 @@ ErrorHandler:
Set WriteExtractionResults = Nothing Set WriteExtractionResults = Nothing
End Function 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
' ------------------------------------------------------------------------------ ' ------------------------------------------------------------------------------
' 打开BOM库文件 ' 打开BOM库文件
' '