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
@@ -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
|
||||
' 功能: 获取[产品订单]工作表
|
||||
|
||||
@@ -60,12 +60,13 @@ Public Sub ProcessProductModels()
|
||||
Dim lastRow As Long
|
||||
lastRow = inputSheet.Cells(inputSheet.Rows.Count, 1).End(xlUp).row
|
||||
|
||||
Dim outputRow As Long
|
||||
outputRow = 2 ' 从第2行开始输出(第1行是表头)
|
||||
|
||||
' 写入输出表头
|
||||
WriteOutputHeader outputSheet
|
||||
|
||||
' 收集所有输出数据
|
||||
Dim outputData As collection
|
||||
Set outputData = New collection
|
||||
|
||||
Dim i As Long
|
||||
Dim modelString As String
|
||||
Dim processedCount As Long
|
||||
@@ -79,12 +80,17 @@ Public Sub ProcessProductModels()
|
||||
componentPriority = Trim(inputSheet.Cells(i, 5).value) ' E列：部件优先
|
||||
|
||||
If modelString <> "" Then
|
||||
' 处理单个型号
|
||||
outputRow = ProcessSingleModel(modelString, componentPriority, BomExtractor, outputSheet, outputRow)
|
||||
' 处理单个型号，收集数据
|
||||
ProcessSingleModel modelString, componentPriority, BomExtractor, outputData
|
||||
processedCount = processedCount + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
' 批量写入数据到工作表
|
||||
If outputData.Count > 0 Then
|
||||
WriteBatchData outputSheet, outputData
|
||||
End If
|
||||
|
||||
' 格式化输出表
|
||||
FormatOutputSheet outputSheet
|
||||
|
||||
@@ -105,25 +111,19 @@ ErrorHandler:
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
' 函数: ProcessSingleModel
|
||||
' 功能: 处理单个产品型号
|
||||
' 过程: ProcessSingleModel
|
||||
' 功能: 处理单个产品型号，将数据添加到输出集合
|
||||
' 参数: modelString - 产品型号字符串
|
||||
' componentPriority - 部件优先标志（"是"或"否"）
|
||||
' bomExtractor - BOM提取器对象
|
||||
' outputSheet - 输出工作表
|
||||
' startRow - 起始行号
|
||||
' 返回: Long - 下一个可用行号
|
||||
' outputData - 输出数据集合
|
||||
'=====================================================================
|
||||
Private Function ProcessSingleModel(modelString As String, _
|
||||
componentPriority As String, _
|
||||
BomExtractor As BomExtractor, _
|
||||
outputSheet As Worksheet, _
|
||||
startRow As Long) As Long
|
||||
Private Sub ProcessSingleModel(modelString 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
|
||||
@@ -142,9 +142,8 @@ Private Function ProcessSingleModel(modelString As String, _
|
||||
If Not parser.Parse(modelString) Then
|
||||
' 解析失败
|
||||
extractNote = "解析失败: " & parser.ErrorMessage
|
||||
WriteOutputRow outputSheet, currentRow, modelString, "", parser.Conditions, extractNote, Nothing
|
||||
ProcessSingleModel = currentRow + 1
|
||||
Exit Function
|
||||
outputData.Add CreateOutputRowArray(modelString, "", parser.Conditions, extractNote, Nothing)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 提取BOM
|
||||
@@ -164,8 +163,7 @@ Private Function ProcessSingleModel(modelString As String, _
|
||||
If extractNote = "" Then
|
||||
extractNote = "未匹配到任何物料"
|
||||
End If
|
||||
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing
|
||||
currentRow = currentRow + 1
|
||||
outputData.Add CreateOutputRowArray(modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing)
|
||||
Else
|
||||
' 输出每个匹配的物料
|
||||
Dim item As BomItem
|
||||
@@ -183,18 +181,14 @@ Private Function ProcessSingleModel(modelString As String, _
|
||||
End If
|
||||
|
||||
If isFirst Then
|
||||
WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, itemNote, item
|
||||
outputData.Add CreateOutputRowArray(modelString, parser.HeaderModel, parser.Conditions, itemNote, item)
|
||||
isFirst = False
|
||||
Else
|
||||
WriteOutputRow outputSheet, currentRow, "", "", parser.Conditions, itemNote, item
|
||||
outputData.Add CreateOutputRowArray("", "", parser.Conditions, itemNote, item)
|
||||
End If
|
||||
|
||||
currentRow = currentRow + 1
|
||||
Next item
|
||||
End If
|
||||
|
||||
ProcessSingleModel = currentRow
|
||||
End Function
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
' 过程: WriteOutputHeader
|
||||
@@ -231,58 +225,109 @@ Private Sub WriteOutputHeader(ws As Worksheet)
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
' 过程: WriteOutputRow
|
||||
' 功能: 写入输出行
|
||||
' 参数: ws - 工作表对象
|
||||
' row - 行号
|
||||
' fullModel - 完整型号
|
||||
' headerModel - 表头型号
|
||||
' conditions - 条件字典
|
||||
' 函数: CreateOutputRowArray
|
||||
' 功能: 创建输出行数据的数组
|
||||
' 参数: FullModel - 完整型号
|
||||
' HeaderModel - 表头型号
|
||||
' Conditions - 条件字典
|
||||
' note - 备注
|
||||
' item - BOM项(可为Nothing)
|
||||
' 返回: Variant() - 行数据数组
|
||||
'=====================================================================
|
||||
Private Sub WriteOutputRow(ws As Worksheet, _
|
||||
row As Long, _
|
||||
FullModel As String, _
|
||||
HeaderModel As String, _
|
||||
Conditions As Object, _
|
||||
note As String, _
|
||||
item As BomItem)
|
||||
Dim col As Long
|
||||
col = 1
|
||||
|
||||
ws.Cells(row, col).value = FullModel: col = col + 1
|
||||
ws.Cells(row, col).value = HeaderModel: col = col + 1
|
||||
|
||||
' 写入条件值
|
||||
Private Function CreateOutputRowArray(FullModel As String, _
|
||||
HeaderModel As String, _
|
||||
Conditions As Object, _
|
||||
note As String, _
|
||||
item As BomItem) As Variant()
|
||||
' 获取条件配置
|
||||
Dim condNames() As String
|
||||
Dim labels() As String
|
||||
GetConditionConfig condNames, labels
|
||||
|
||||
' 计算总列数：2 + 条件数 + 8
|
||||
Dim totalCols As Long
|
||||
totalCols = 2 + (UBound(condNames) - LBound(condNames) + 1) + 8
|
||||
|
||||
' 创建数组
|
||||
ReDim rowData(1 To totalCols) As Variant
|
||||
|
||||
Dim col As Long
|
||||
col = 1
|
||||
|
||||
' 产品型号和表头型号
|
||||
rowData(col) = FullModel: col = col + 1
|
||||
rowData(col) = HeaderModel: col = col + 1
|
||||
|
||||
' 写入条件值
|
||||
Dim i As Long
|
||||
For i = LBound(condNames) To UBound(condNames)
|
||||
If Conditions.Exists(condNames(i)) Then
|
||||
ws.Cells(row, col).value = Conditions(condNames(i))
|
||||
rowData(col) = Conditions(condNames(i))
|
||||
Else
|
||||
ws.Cells(row, col).value = ""
|
||||
rowData(col) = ""
|
||||
End If
|
||||
col = col + 1
|
||||
Next i
|
||||
|
||||
' 写入BOM数据
|
||||
If Not item Is Nothing Then
|
||||
ws.Cells(row, col).value = item.RowNumber: col = col + 1
|
||||
ws.Cells(row, col).value = item.Module: col = col + 1
|
||||
ws.Cells(row, col).value = item.code: col = col + 1
|
||||
ws.Cells(row, col).value = item.Name: col = col + 1
|
||||
ws.Cells(row, col).value = item.Quantity: col = col + 1
|
||||
ws.Cells(row, col).value = item.category: col = col + 1
|
||||
ws.Cells(row, col).value = item.Code66: col = col + 1
|
||||
rowData(col) = item.RowNumber: col = col + 1
|
||||
rowData(col) = item.Module: col = col + 1
|
||||
rowData(col) = item.code: col = col + 1
|
||||
rowData(col) = item.Name: col = col + 1
|
||||
rowData(col) = item.Quantity: col = col + 1
|
||||
rowData(col) = item.category: col = col + 1
|
||||
rowData(col) = item.Code66: col = col + 1
|
||||
Else
|
||||
col = col + 7 ' 跳过BOM字段
|
||||
' 跳过BOM字段
|
||||
col = col + 7
|
||||
End If
|
||||
|
||||
ws.Cells(row, col).value = note
|
||||
' 备注
|
||||
rowData(col) = note
|
||||
|
||||
CreateOutputRowArray = 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 firstRow As Variant
|
||||
firstRow = outputData(1)
|
||||
|
||||
Dim rowCount As Long
|
||||
Dim colCount As Long
|
||||
rowCount = outputData.Count
|
||||
colCount = UBound(firstRow) - LBound(firstRow) + 1
|
||||
|
||||
' 创建二维数组
|
||||
Dim resultData() As Variant
|
||||
ReDim resultData(1 To rowCount, 1 To colCount)
|
||||
|
||||
' 填充数据到二维数组
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim rowArray As Variant
|
||||
|
||||
For i = 1 To rowCount
|
||||
rowArray = outputData(i)
|
||||
For j = 1 To colCount
|
||||
resultData(i, j) = rowArray(j)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
' 一次性写入工作表（从第2行开始）
|
||||
ws.Range("A2").Resize(rowCount, colCount).value = resultData
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
|
||||
Reference in New Issue
Block a user