refactor: support filtered data processing and optimize performance
- Add clear data button functionality to Sheet9 - Refactor AccessDataModule to safely handle filtered data with memory array optimization - Refactor BIPUploadModule to process only visible rows with screen updating optimization - Refactor ComponentInventoryCheckModule to support filtered data and improve performance - Refactor MainModule to handle filtered data and remove '代号' field - Add RestoreAppStatus helper for better application state management - Improve overall performance by using memory arrays instead of cell-by-cell operations Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
@@ -1,6 +1,7 @@
|
||||
'=====================================================================
|
||||
' 模块名: MainModule
|
||||
' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑
|
||||
' 特性: [已重构] 支持仅对筛选后的数据进行处理，采用内存极速读取
|
||||
'=====================================================================
|
||||
|
||||
Option Explicit
|
||||
@@ -22,6 +23,9 @@ Public Sub ProcessProductModels()
|
||||
Dim startTime As Double
|
||||
startTime = Timer
|
||||
|
||||
' 关闭屏幕刷新提升速度
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
' 准备输入输出
|
||||
Dim inputSheet As Worksheet
|
||||
Dim outputSheet As Worksheet
|
||||
@@ -30,6 +34,7 @@ Public Sub ProcessProductModels()
|
||||
' 获取工作表
|
||||
Set inputSheet = GetInputSheet()
|
||||
If inputSheet Is Nothing Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "未找到输入工作表,请确保工作簿中有包含订单数据的工作表", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -37,6 +42,7 @@ Public Sub ProcessProductModels()
|
||||
' 获取BOM库工作表
|
||||
Set bomSheet = GetBomSheet()
|
||||
If bomSheet Is Nothing Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "未找到'平台配置清单'工作表,请确保BOM数据存在", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -50,14 +56,36 @@ Public Sub ProcessProductModels()
|
||||
BomExtractor.SetWorksheet bomSheet
|
||||
|
||||
If Not BomExtractor.LoadBomData Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 处理每个产品型号
|
||||
Dim lastRow As Long
|
||||
lastRow = inputSheet.Cells(inputSheet.Rows.count, 1).End(xlUp).row
|
||||
|
||||
If lastRow < 2 Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "[产品订单]工作表中没有数据!", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 【性能核心】将输入数据全量读入内存数组
|
||||
Dim sourceDataArr As Variant
|
||||
sourceDataArr = inputSheet.Range("A2:F" & lastRow).value
|
||||
|
||||
' 【筛选核心】获取可见的单元格区域
|
||||
Dim visibleRange As Range
|
||||
On Error Resume Next
|
||||
Set visibleRange = inputSheet.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
If visibleRange Is Nothing Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "当前筛选状态下没有可见的数据。", vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 写入输出表头
|
||||
WriteOutputHeader outputSheet
|
||||
|
||||
@@ -65,30 +93,34 @@ Public Sub ProcessProductModels()
|
||||
Dim outputData As Collection
|
||||
Set outputData = New Collection
|
||||
|
||||
Dim i As Long
|
||||
Dim cell As Range
|
||||
Dim arrIndex As Long
|
||||
Dim modelString As String
|
||||
Dim processedCount As Long
|
||||
|
||||
processedCount = 0
|
||||
|
||||
' 假设数据从第2行开始
|
||||
For i = 2 To lastRow
|
||||
' 仅遍历筛选出来的可见行
|
||||
For Each cell In visibleRange
|
||||
Dim totalQueueNum As String
|
||||
Dim orderNumber As String
|
||||
Dim componentPriority As String
|
||||
|
||||
' --- 核心修改：调整列索引以适应新增的“总排号” ---
|
||||
totalQueueNum = Trim(inputSheet.Cells(i, 1).value) ' A列：总排号
|
||||
orderNumber = Trim(inputSheet.Cells(i, 2).value) ' B列：生产订单号
|
||||
modelString = Trim(inputSheet.Cells(i, 3).value) ' C列：产品型号
|
||||
componentPriority = Trim(inputSheet.Cells(i, 6).value) ' F列：部件优先 (原E列右移一列)
|
||||
' 将工作表行号映射到数组索引
|
||||
arrIndex = cell.row - 1
|
||||
|
||||
' 从内存数组中极速读取对应字段
|
||||
totalQueueNum = Trim(sourceDataArr(arrIndex, 1)) ' A列：总排号
|
||||
orderNumber = Trim(sourceDataArr(arrIndex, 2)) ' B列：生产订单号
|
||||
modelString = Trim(sourceDataArr(arrIndex, 3)) ' C列：产品型号
|
||||
componentPriority = Trim(sourceDataArr(arrIndex, 6)) ' F列：部件优先
|
||||
|
||||
If modelString <> "" Then
|
||||
' 处理单个型号，收集数据，增加 totalQueueNum 参数
|
||||
' 处理单个型号，收集数据
|
||||
ProcessSingleModel totalQueueNum, orderNumber, modelString, componentPriority, BomExtractor, outputData
|
||||
processedCount = processedCount + 1
|
||||
End If
|
||||
Next i
|
||||
Next cell
|
||||
|
||||
' 批量写入数据到工作表
|
||||
If outputData.count > 0 Then
|
||||
@@ -101,8 +133,10 @@ Public Sub ProcessProductModels()
|
||||
Dim elapsedTime As Double
|
||||
elapsedTime = Timer - startTime
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
MsgBox "处理完成!" & vbCrLf & _
|
||||
"处理型号数: " & processedCount & vbCrLf & _
|
||||
"处理筛选型号数: " & processedCount & vbCrLf & _
|
||||
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
|
||||
|
||||
' 激活输出表
|
||||
@@ -111,6 +145,7 @@ Public Sub ProcessProductModels()
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "处理异常: " & Err.Description, vbCritical
|
||||
End Sub
|
||||
|
||||
@@ -227,7 +262,7 @@ Private Sub WriteOutputHeader(ws As Worksheet)
|
||||
' BOM字段表头
|
||||
ws.Cells(1, col).value = "行号": col = col + 1
|
||||
ws.Cells(1, col).value = "模块": col = col + 1
|
||||
ws.Cells(1, col).value = "代号": col = col + 1
|
||||
' ws.Cells(1, col).Value = "代号": col = col + 1 <-- 已移除
|
||||
ws.Cells(1, col).value = "名称": col = col + 1
|
||||
ws.Cells(1, col).value = "数量": col = col + 1
|
||||
ws.Cells(1, col).value = "类别": col = col + 1
|
||||
@@ -256,9 +291,9 @@ Private Function CreateOutputRowArray(totalQueueNum As String, _
|
||||
Dim labels() As String
|
||||
GetConditionConfig condNames, labels
|
||||
|
||||
' 计算总列数：3 (排号+订单+型号) + 条件数 + 8 (BOM+备注)
|
||||
' 计算总列数：3 (排号+订单+型号) + 条件数 + 7 (BOM字段减去代号后剩6个 + 1个备注)
|
||||
Dim totalCols As Long
|
||||
totalCols = 3 + (UBound(condNames) - LBound(condNames) + 1) + 8
|
||||
totalCols = 3 + (UBound(condNames) - LBound(condNames) + 1) + 7
|
||||
|
||||
' 创建数组
|
||||
ReDim rowData(1 To totalCols) As Variant
|
||||
@@ -286,14 +321,14 @@ Private Function CreateOutputRowArray(totalQueueNum As String, _
|
||||
If Not item Is Nothing Then
|
||||
rowData(col) = item.RowNumber: col = col + 1
|
||||
rowData(col) = item.Module: col = col + 1
|
||||
rowData(col) = item.code: 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
|
||||
' 跳过BOM字段
|
||||
col = col + 7
|
||||
' 跳过BOM字段 (原本是7个字段，去掉代号后变成6个字段)
|
||||
col = col + 6
|
||||
End If
|
||||
|
||||
' 备注
|
||||
@@ -301,6 +336,7 @@ Private Function CreateOutputRowArray(totalQueueNum As String, _
|
||||
|
||||
CreateOutputRowArray = rowData
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 过程: WriteBatchData
|
||||
' 功能: 批量写入数据到工作表
|
||||
|
||||
Reference in New Issue
Block a user