perf: optimize output logic using batch array writes

Optimize BIPUploadModule and MainModule for better performance:
- Replace cell-by-cell writes with batch array operations
- Collect all output data in memory using Collection objects
- Use WriteBatchData to write all data in single operation
- Add CreateBIPRowArray and CreateOutputRowArray helper functions
- Remove deprecated WriteBIPRow and WriteOutputRow functions

Performance improvement:
- Before: N cell write operations per row (thousands of Excel calls)
- After: 1 batch write operation for all data
- Expected speedup: 10-100x depending on data volume

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka
2026-02-01 23:06:26 +08:00
parent 73491c104b
commit d68dc945bc
2 changed files with 211 additions and 150 deletions

View File

@@ -74,9 +74,9 @@ Public Sub ProcessOrdersToBIP()
Exit Sub
End If
' 处理每个订单
Dim outputRow As Long
outputRow = 2 ' 从第2行开始输出第1行是表头
' 处理每个订单,收集所有输出数据
Dim outputData As collection
Set outputData = New collection
Dim i As Long
Dim processedCount As Long
@@ -122,14 +122,19 @@ Public Sub ProcessOrdersToBIP()
orderCount = orderCount + 1
' 处理单个订单
outputRow = ProcessSingleOrder(orderNumber, productModel, quantity, productCode, _
componentPriority, BomExtractor, bipSheet, outputRow)
' 处理单个订单,收集输出数据
ProcessSingleOrder orderNumber, productModel, quantity, productCode, _
componentPriority, BomExtractor, outputData
processedCount = processedCount + 1
ContinueLoop:
Next i
' 批量写入数据到工作表
If outputData.Count > 0 Then
WriteBatchData bipSheet, outputData
End If
' 格式化BIP上传模板
FormatBIPSheet bipSheet
@@ -138,7 +143,7 @@ ContinueLoop:
MsgBox "处理完成!" & vbCrLf & _
"处理订单数: " & orderCount & vbCrLf & _
"生成BIP行数: " & (outputRow - 2) & vbCrLf & _
"生成BIP行数: " & outputData.Count & vbCrLf & _
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
' 激活BIP上传模板
@@ -151,31 +156,25 @@ ErrorHandler:
End Sub
'=====================================================================
' 函数: ProcessSingleOrder
' 功能: 处理单个订单提取BOM并写入BIP上传模板
' 过程: ProcessSingleOrder
' 功能: 处理单个订单提取BOM并将数据添加到输出集合
' 参数: orderNumber - 生产订单号
' productModel - 产品型号
' quantity - 生产数量
' productCode - 产品编码
' componentPriority - 部件优先标志("是"或"否"
' BomExtractor - BOM提取器对象
' bipSheet - BIP上传模板工作表
' startRow - 起始行号
' 返回: Long - 下一个可用行号
' outputData - 输出数据集合
'=====================================================================
Private Function ProcessSingleOrder(orderNumber As String, _
productModel As String, _
quantity As String, _
productCode As String, _
componentPriority As String, _
BomExtractor As BomExtractor, _
bipSheet As Worksheet, _
startRow As Long) As Long
Private Sub ProcessSingleOrder(orderNumber As String, _
productModel As String, _
quantity As String, _
productCode As String, _
componentPriority As String, _
BomExtractor As BomExtractor, _
outputData As collection)
On Error Resume Next
Dim currentRow As Long
currentRow = startRow
' 根据部件优先设置排除类别
BomExtractor.ClearExcludeCategories
If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
@@ -192,12 +191,10 @@ Private Function ProcessSingleOrder(orderNumber As String, _
extractNote = ""
If Not parser.Parse(productModel) Then
' 解析失败,写入一行错误记录
' 解析失败,添加一行错误记录
extractNote = "解析失败: " & parser.ErrorMessage
WriteBIPRow bipSheet, currentRow, orderNumber, productCode, quantity, _
1, "", extractNote
ProcessSingleOrder = currentRow + 1
Exit Function
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
Exit Sub
End If
' 提取BOM
@@ -213,13 +210,11 @@ Private Function ProcessSingleOrder(orderNumber As String, _
' 输出结果
If matchedItems.Count = 0 Then
' 没有匹配项,写入一行空记录
' 没有匹配项,添加一行空记录
If extractNote = "" Then
extractNote = "未匹配到任何物料"
End If
WriteBIPRow bipSheet, currentRow, orderNumber, productCode, quantity, _
1, "", extractNote
currentRow = currentRow + 1
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
Else
' 输出每个匹配的物料
Dim item As BomItem
@@ -236,18 +231,90 @@ Private Function ProcessSingleOrder(orderNumber As String, _
itemNote = itemNote & item.MatchError
End If
' 写入BIP行
WriteBIPRow bipSheet, currentRow, orderNumber, productCode, quantity, _
lineIndex, item.Code66, itemNote
' 创建BIP行数据并添加到集合
outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, _
lineIndex, item.Code66, itemNote)
currentRow = currentRow + 1
lineIndex = lineIndex + 1
Next item
End If
End Sub
ProcessSingleOrder = currentRow
'=====================================================================
' 函数: CreateBIPRowArray
' 功能: 创建BIP上传模板一行数据的数组
' 参数: orderNumber - 生产订单号
' productCode - 产品编码
' quantity - 生产数量
' lineIndex - 行号索引从1开始
' materialCode - 材料编码66编码
' note - 备注
' 返回: Variant() - 包含10个元素的数组
'=====================================================================
Private Function CreateBIPRowArray(orderNumber As String, _
productCode As String, _
quantity As String, _
lineIndex As Long, _
materialCode As String, _
note As String) As Variant()
Dim rowData(1 To 10) As Variant
rowData(1) = orderNumber ' 来源单据号(生产订单号)
rowData(2) = productCode ' 产品编码
rowData(3) = quantity ' 生产数量
rowData(4) = ROW_NUMBER_BASE + lineIndex ' 行号 = 基数 + 索引
rowData(5) = materialCode ' 材料编码66编码
rowData(6) = "一般发料" ' 供应方式(固定值)
rowData(7) = Date ' 需用日期(当天日期)
rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织(固定值)
rowData(9) = quantity ' 计划出库数量(与生产数量一致)
rowData(10) = note ' 备注
CreateBIPRowArray = rowData
End Function
'=====================================================================
' 过程: WriteBatchData
' 功能: 批量写入数据到工作表
' 参数: ws - 工作表对象
' outputData - 输出数据集合,每个元素是一个一维数组
'=====================================================================
Private Sub WriteBatchData(ws As Worksheet, outputData As collection)
' 如果没有数据,直接返回
If outputData.Count = 0 Then
Exit Sub
End If
' 创建二维数组
Dim rowCount As Long
rowCount = outputData.Count
Dim resultData() As Variant
ReDim resultData(1 To rowCount, 1 To 10)
' 填充数据到二维数组
Dim i As Long
Dim rowArray As Variant
For i = 1 To rowCount
rowArray = outputData(i)
resultData(i, 1) = rowArray(1)
resultData(i, 2) = rowArray(2)
resultData(i, 3) = rowArray(3)
resultData(i, 4) = rowArray(4)
resultData(i, 5) = rowArray(5)
resultData(i, 6) = rowArray(6)
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
End Sub
'=====================================================================
' 过程: WriteBIPHeader
' 功能: 写入BIP上传模板表头
@@ -267,57 +334,6 @@ Private Sub WriteBIPHeader(ws As Worksheet)
ws.Cells(1, 10).value = "备注"
End Sub
'=====================================================================
' 过程: WriteBIPRow
' 功能: 写入BIP上传模板数据行
' 参数: ws - 工作表对象
' row - 行号
' orderNumber - 生产订单号
' productCode - 产品编码
' quantity - 生产数量
' lineIndex - 行号索引从1开始
' materialCode - 材料编码66编码
' note - 备注
'=====================================================================
Private Sub WriteBIPRow(ws As Worksheet, _
row As Long, _
orderNumber As String, _
productCode As String, _
quantity As String, _
lineIndex As Long, _
materialCode As String, _
note As String)
' 列1来源单据号生产订单号
ws.Cells(row, 1).value = orderNumber
' 列2产品编码
ws.Cells(row, 2).value = productCode
' 列3生产数量
ws.Cells(row, 3).value = quantity
' 列4行号 = 基数 + 索引
ws.Cells(row, 4).value = ROW_NUMBER_BASE + lineIndex
' 列5材料编码66编码
ws.Cells(row, 5).value = materialCode
' 列6供应方式固定值
ws.Cells(row, 6).value = "一般发料"
' 列7需用日期当天日期
ws.Cells(row, 7).value = Date
' 列8发料组织固定值
ws.Cells(row, 8).value = "重庆布莱迪仪器仪表有限公司"
' 列9计划出库数量与生产数量一致
ws.Cells(row, 9).value = quantity
' 列10备注
ws.Cells(row, 10).value = note
End Sub
'=====================================================================
' 函数: GetOrderSheet
' 功能: 获取[产品订单]工作表