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 @@
|
||||
'=====================================================================
|
||||
' 模块名: BIPUploadModule
|
||||
' 功能: 处理产品订单数据，提取BOM后生成[BIP上传模板]格式数据
|
||||
' 特性: [已重构] 支持仅对筛选后的数据进行处理，采用内存极速读取
|
||||
'=====================================================================
|
||||
|
||||
Option Explicit
|
||||
@@ -22,6 +23,8 @@ Public Sub ProcessOrdersToBIP()
|
||||
Dim startTime As Double
|
||||
startTime = Timer
|
||||
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
' 准备工作表对象
|
||||
Dim orderSheet As Worksheet
|
||||
Dim bipSheet As Worksheet
|
||||
@@ -30,6 +33,7 @@ Public Sub ProcessOrdersToBIP()
|
||||
' 获取[产品订单]工作表
|
||||
Set orderSheet = GetOrderSheet()
|
||||
If orderSheet Is Nothing Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "未找到[产品订单]工作表!", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -40,6 +44,7 @@ Public Sub ProcessOrdersToBIP()
|
||||
' 获取BOM库工作表
|
||||
Set bomSheet = GetBomSheet()
|
||||
If bomSheet Is Nothing Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "未找到[平台配置清单]工作表!", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -50,6 +55,7 @@ Public Sub ProcessOrdersToBIP()
|
||||
BomExtractor.SetWorksheet bomSheet
|
||||
|
||||
If Not BomExtractor.LoadBomData Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -66,22 +72,44 @@ Public Sub ProcessOrdersToBIP()
|
||||
|
||||
' 如果只有表头或没有数据
|
||||
If lastRow < 2 Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "[产品订单]工作表中没有数据!", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 处理每个订单，收集所有输出数据
|
||||
' 【性能核心】全量读入源数据
|
||||
Dim sourceDataArr As Variant
|
||||
sourceDataArr = orderSheet.Range("A2:F" & lastRow).value
|
||||
|
||||
' 【筛选核心】获取可见区域
|
||||
Dim visibleRange As Range
|
||||
On Error Resume Next
|
||||
Set visibleRange = orderSheet.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
If visibleRange Is Nothing Then
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "当前筛选状态下没有可见的数据。", vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 收集所有输出数据
|
||||
Dim outputData As Collection
|
||||
Set outputData = New Collection
|
||||
|
||||
Dim i As Long
|
||||
Dim cell As Range
|
||||
Dim arrIndex As Long
|
||||
Dim processedCount As Long
|
||||
Dim orderCount As Long
|
||||
|
||||
processedCount = 0
|
||||
orderCount = 0
|
||||
|
||||
For i = 2 To lastRow
|
||||
' 遍历筛选出来的可见单元格
|
||||
For Each cell In visibleRange
|
||||
' 计算内存数组索引
|
||||
arrIndex = cell.row - 1
|
||||
|
||||
' 读取订单数据
|
||||
Dim totalQueueNum As String
|
||||
Dim orderNumber As String
|
||||
@@ -90,13 +118,12 @@ Public Sub ProcessOrdersToBIP()
|
||||
Dim productCode As String
|
||||
Dim componentPriority As String
|
||||
|
||||
' --- 核心修改：调整列索引以适应新增的A列“总排号” ---
|
||||
totalQueueNum = Trim(orderSheet.Cells(i, 1).value) ' A列：总排号 (如果后续BIP需要可直接使用此变量)
|
||||
orderNumber = Trim(orderSheet.Cells(i, 2).value) ' B列：生产订单号
|
||||
ProductModel = Trim(orderSheet.Cells(i, 3).value) ' C列：产品型号
|
||||
Quantity = Trim(orderSheet.Cells(i, 4).value) ' D列：数量
|
||||
productCode = Trim(orderSheet.Cells(i, 5).value) ' E列：产品编码
|
||||
componentPriority = Trim(orderSheet.Cells(i, 6).value) ' F列：部件优先
|
||||
totalQueueNum = Trim(sourceDataArr(arrIndex, 1)) ' A列：总排号
|
||||
orderNumber = Trim(sourceDataArr(arrIndex, 2)) ' B列：生产订单号
|
||||
ProductModel = Trim(sourceDataArr(arrIndex, 3)) ' C列：产品型号
|
||||
Quantity = Trim(sourceDataArr(arrIndex, 4)) ' D列：数量
|
||||
productCode = Trim(sourceDataArr(arrIndex, 5)) ' E列：产品编码
|
||||
componentPriority = Trim(sourceDataArr(arrIndex, 6)) ' F列：部件优先
|
||||
|
||||
' 跳过空行
|
||||
If orderNumber = "" And ProductModel = "" Then
|
||||
@@ -105,17 +132,17 @@ Public Sub ProcessOrdersToBIP()
|
||||
|
||||
' 验证必填字段
|
||||
If orderNumber = "" Then
|
||||
MsgBox "第" & i & "行：生产订单号为空，跳过该行!", vbExclamation
|
||||
MsgBox "工作表第" & cell.row & "行：生产订单号为空，跳过该行!", vbExclamation
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
If ProductModel = "" Then
|
||||
MsgBox "第" & i & "行：产品型号为空，跳过该行!", vbExclamation
|
||||
MsgBox "工作表第" & cell.row & "行：产品型号为空，跳过该行!", vbExclamation
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
If Quantity = "" Then
|
||||
MsgBox "第" & i & "行：数量为空，跳过该行!", vbExclamation
|
||||
MsgBox "工作表第" & cell.row & "行：数量为空，跳过该行!", vbExclamation
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
@@ -123,11 +150,11 @@ Public Sub ProcessOrdersToBIP()
|
||||
|
||||
' 处理单个订单，收集输出数据
|
||||
ProcessSingleOrder orderNumber, ProductModel, Quantity, productCode, _
|
||||
componentPriority, BomExtractor, outputData
|
||||
componentPriority, BomExtractor, outputData
|
||||
processedCount = processedCount + 1
|
||||
|
||||
ContinueLoop:
|
||||
Next i
|
||||
Next cell
|
||||
|
||||
' 批量写入数据到工作表
|
||||
If outputData.count > 0 Then
|
||||
@@ -140,8 +167,10 @@ ContinueLoop:
|
||||
Dim elapsedTime As Double
|
||||
elapsedTime = Timer - startTime
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
MsgBox "处理完成!" & vbCrLf & _
|
||||
"处理订单数: " & orderCount & vbCrLf & _
|
||||
"处理筛选订单数: " & orderCount & vbCrLf & _
|
||||
"生成BIP行数: " & outputData.count & vbCrLf & _
|
||||
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
|
||||
|
||||
@@ -151,6 +180,7 @@ ContinueLoop:
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
Application.ScreenUpdating = True
|
||||
MsgBox "处理异常: " & Err.Description, vbCritical
|
||||
End Sub
|
||||
|
||||
@@ -284,7 +314,7 @@ Private Function CreateBIPRowArray(orderNumber As String, _
|
||||
rowData(5) = materialCode ' 材料编码（66 编码）
|
||||
rowData(6) = "一般发料" ' 供应方式（固定值）
|
||||
rowData(7) = Date ' 需用日期（当天日期）
|
||||
rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值）
|
||||
rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值）
|
||||
rowData(9) = Quantity ' 计划出库数量（与生产数量一致）
|
||||
rowData(10) = note ' 备注
|
||||
|
||||
|
||||
Reference in New Issue
Block a user