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>

VBA/Modules/BIPUploadModule.bas

@@ -74,9 +74,9 @@ Public Sub ProcessOrdersToBIP()
         Exit Sub
     End If
 
-    ' 处理每个订单
+    ' 处理每个订单，收集所有输出数据
-    Dim outputRow As Long
+    Dim outputData As collection
-    outputRow = 2 ' 从第2行开始输出（第1行是表头）
+    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, _
+        ProcessSingleOrder orderNumber, productModel, quantity, productCode, _
-                                       componentPriority, BomExtractor, bipSheet, outputRow)
+                          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
+' 过程: ProcessSingleOrder
-' 功能: 处理单个订单，提取BOM并写入BIP上传模板
+' 功能: 处理单个订单，提取BOM并将数据添加到输出集合
 ' 参数: orderNumber - 生产订单号
 '       productModel - 产品型号
 '       quantity - 生产数量
 '       productCode - 产品编码
 '       componentPriority - 部件优先标志（"是"或"否"）
 '       BomExtractor - BOM提取器对象
-'       bipSheet - BIP上传模板工作表
+'       outputData - 输出数据集合
-'       startRow - 起始行号
-' 返回: Long - 下一个可用行号
 '=====================================================================
-Private Function ProcessSingleOrder(orderNumber As String, _
+Private Sub ProcessSingleOrder(orderNumber As String, _
                               productModel As String, _
                               quantity As String, _
                               productCode As String, _
                               componentPriority As String, _
                               BomExtractor As BomExtractor, _
-                                   bipSheet As Worksheet, _
+                              outputData As collection)
-                                   startRow As Long) As Long
     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, _
+        outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
-                    1, "", extractNote
+        Exit Sub
-        ProcessSingleOrder = currentRow + 1
-        Exit Function
     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, _
+        outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote)
-                    1, "", extractNote
-        currentRow = currentRow + 1
     Else
         ' 输出每个匹配的物料
         Dim item As BomItem
@@ -236,18 +231,90 @@ Private Function ProcessSingleOrder(orderNumber As String, _
                 itemNote = itemNote & item.MatchError
             End If
 
-            ' 写入BIP行
+            ' 创建BIP行数据并添加到集合
-            WriteBIPRow bipSheet, currentRow, orderNumber, productCode, quantity, _
+            outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, _
-                        lineIndex, item.Code66, itemNote
+                                            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
 ' 功能: 获取[产品订单]工作表

VBA/Modules/MainModule.bas

@@ -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 - 输出工作表
+'       outputData - 输出数据集合
-'       startRow - 起始行号
-' 返回: Long - 下一个可用行号
 '=====================================================================
-Private Function ProcessSingleModel(modelString As String, _
+Private Sub ProcessSingleModel(modelString As String, _
                               componentPriority As String, _
                               BomExtractor As BomExtractor, _
-                                    outputSheet As Worksheet, _
+                              outputData As collection)
-                                    startRow As Long) As Long
     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
+        outputData.Add CreateOutputRowArray(modelString, "", parser.Conditions, extractNote, Nothing)
-        ProcessSingleModel = currentRow + 1
+        Exit Sub
-        Exit Function
     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
+        outputData.Add CreateOutputRowArray(modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing)
-        currentRow = currentRow + 1
     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
-
+End Sub
-    ProcessSingleModel = currentRow
-End Function
 
 '=====================================================================
 ' 过程: WriteOutputHeader
@@ -231,58 +225,109 @@ Private Sub WriteOutputHeader(ws As Worksheet)
 End Sub
 
 '=====================================================================
-' 过程: WriteOutputRow
+' 函数: CreateOutputRowArray
-' 功能: 写入输出行
+' 功能: 创建输出行数据的数组
-' 参数: ws - 工作表对象
+' 参数: FullModel - 完整型号
-'       row - 行号
+'       HeaderModel - 表头型号
-'       fullModel - 完整型号
+'       Conditions - 条件字典
-'       headerModel - 表头型号
-'       conditions - 条件字典
 '       note - 备注
 '       item - BOM项(可为Nothing)
+' 返回: Variant() - 行数据数组
 '=====================================================================
-Private Sub WriteOutputRow(ws As Worksheet, _
+Private Function CreateOutputRowArray(FullModel As String, _
-                          row As Long, _
-                          FullModel As String, _
                                     HeaderModel As String, _
                                     Conditions As Object, _
                                     note As String, _
-                          item As BomItem)
+                                    item As BomItem) As Variant()
-    Dim col As Long
+    ' 获取条件配置
-    col = 1
-
-    ws.Cells(row, col).value = FullModel: col = col + 1
-    ws.Cells(row, col).value = HeaderModel: col = col + 1
-
-    ' 写入条件值
     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
+        rowData(col) = item.RowNumber: col = col + 1
-        ws.Cells(row, col).value = item.Module: col = col + 1
+        rowData(col) = item.Module: col = col + 1
-        ws.Cells(row, col).value = item.code: col = col + 1
+        rowData(col) = item.code: col = col + 1
-        ws.Cells(row, col).value = item.Name: col = col + 1
+        rowData(col) = item.Name: col = col + 1
-        ws.Cells(row, col).value = item.Quantity: col = col + 1
+        rowData(col) = item.Quantity: col = col + 1
-        ws.Cells(row, col).value = item.category: col = col + 1
+        rowData(col) = item.category: col = col + 1
-        ws.Cells(row, col).value = item.Code66: 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
 
 '=====================================================================