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

@@ -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
'=====================================================================