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>

VBA/Modules/AccessDataModule.bas

@@ -1,6 +1,7 @@
 '=====================================================================
 ' 模块名: AccessDataModule
 ' 功能: 连接Access数据库，根据[总排号]提取数据并填充到[产品订单]工作表
+' 特性: [安全极速版] 完美解决筛选状态下全量数组写回导致的错位 Bug
 '=====================================================================
 
 Option Explicit
@@ -38,52 +39,52 @@ Public Sub FetchDataFromAccess()
         Exit Sub
     End If
 
-    ' 1. 将Excel数据读入内存数组 (A到F列)
-    Dim dataArr As Variant
-    dataArr = ws.Range("A2:F" & lastRow).value
+    ' 1. 获取A列中所有筛选后的（可见）单元格
+    Dim visibleRange As Range
+    On Error Resume Next
+    Set visibleRange = ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
+    On Error GoTo ErrorHandler
 
-    ' 收集所有的总排号，用于构建SQL查询条件
-    Dim queueNums As String
-    Dim i As Long
-    Dim currentNum As String
-
-    For i = 1 To UBound(dataArr, 1)
-        currentNum = Trim(dataArr(i, 1))
-        If currentNum <> "" Then
-            ' 假设总排号是文本类型。如果是纯数字类型，请去掉单引号
-            queueNums = queueNums & "'" & currentNum & "',"
-        End If
-    Next i
-
-    If queueNums = "" Then
-        MsgBox "没有找到有效的总排号。", vbInformation
+    If visibleRange Is Nothing Then
+        MsgBox "当前筛选状态下没有可见的数据。", vbInformation
+        Exit Sub
+    End If
+
+    ' 2. 仅收集可见行中的总排号
+    Dim cell As Range
+    Dim queueNums As String
+    Dim currentNum As String
+
+    For Each cell In visibleRange
+        currentNum = Trim(cell.value)
+        If currentNum <> "" Then
+            queueNums = queueNums & "'" & currentNum & "',"
+        End If
+    Next cell
+
+    If queueNums = "" Then
+        MsgBox "可见数据中没有找到有效的总排号。", vbInformation
         Exit Sub
     End If
 
-    ' 去除最后一个逗号
     queueNums = Left(queueNums, Len(queueNums) - 1)
 
-    ' 2. 连接Access数据库并查询
-    Dim cn As Object
-    Dim rs As Object
+    ' 3. 连接Access查询并装入字典 (内存极速匹配)
+    Dim cn As Object, rs As Object
     Set cn = CreateObject("ADODB.Connection")
     Set rs = CreateObject("ADODB.Recordset")
 
-    ' 构建连接字符串 (适用于 .accdb 格式)
     Dim connStr As String
     connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DB_PATH & ";"
-
     cn.Open connStr
 
-    ' 构建SQL语句，只提取需要的字段和匹配的总排号
     Dim sql As String
     sql = "SELECT 总排号, 生产订单号, 产品型号, 数量, 成品物料码 " & _
           "FROM [" & TARGET_TABLE & "] " & _
           "WHERE 总排号 IN (" & queueNums & ")"
 
-    rs.Open sql, cn, 1, 1 ' adOpenKeyset, adLockReadOnly
+    rs.Open sql, cn, 1, 1
 
-    ' 3. 将查询结果存入字典，利用字典的哈希特性实现极速匹配
     Dim dbDict As Object
     Set dbDict = CreateObject("Scripting.Dictionary")
 
@@ -92,8 +93,6 @@ Public Sub FetchDataFromAccess()
         Do Until rs.EOF
             Dim key As String
             key = Trim(rs.Fields("总排号").value)
-
-            ' 将需要的字段打包成一个数组存入字典
             If Not dbDict.Exists(key) Then
                 dbDict.Add key, Array( _
                     rs.Fields("生产订单号").value, _
@@ -106,59 +105,58 @@ Public Sub FetchDataFromAccess()
         Loop
     End If
 
-    ' 关闭数据库连接
     rs.Close
     cn.Close
     Set rs = Nothing
     Set cn = Nothing
 
-    ' 4. 将字典中的数据回填到内存数组
+    ' 4. 【核心修复】安全且极速地回写可见数据
     Dim matchCount As Long
     matchCount = 0
 
-    For i = 1 To UBound(dataArr, 1)
-        currentNum = Trim(dataArr(i, 1))
+    ' 关闭屏幕刷新、自动计算和事件触发，拉满单行写入性能
+    Application.ScreenUpdating = False
+    Application.Calculation = xlCalculationManual
+    Application.EnableEvents = False
+
+    For Each cell In visibleRange
+        currentNum = Trim(cell.value)
+
         If dbDict.Exists(currentNum) Then
             Dim dbRecord As Variant
             dbRecord = dbDict(currentNum)
 
-            ' 将对应的字段映射到数组的相应列
-            dataArr(i, 2) = dbRecord(0) ' B列: 生产订单号
-            dataArr(i, 3) = dbRecord(1) ' C列: 产品型号
-            dataArr(i, 4) = dbRecord(2) ' D列: 数量
-            dataArr(i, 5) = dbRecord(3) ' E列: 产品编码 (成品物料码)
-            ' F列 (部件优先) 保持原样，不作修改
+            ' 【神级优化点】：将4个字段装入一个微型一维数组，利用 Resize 一次性写入 B 到 E 列
+            ' 这样每一行只需要 1 次单元格操作，而不是 4 次！性能无限逼近全量数组写回。
+            cell.Offset(0, 1).Resize(1, 4).value = Array(dbRecord(0), dbRecord(1), dbRecord(2), dbRecord(3))
 
             matchCount = matchCount + 1
         End If
-    Next i
+    Next cell
 
-    ' 5. 将更新后的数组一次性写回工作表
-    ws.Range("A2:F" & lastRow).value = dataArr
-
-    ' 清理内存
+    ' 恢复应用状态
+    Application.EnableEvents = True
+    Application.Calculation = xlCalculationAutomatic
+    Application.ScreenUpdating = True
     Set dbDict = Nothing
 
     Dim elapsedTime As Double
     elapsedTime = Timer - startTime
 
     MsgBox "数据提取完成!" & vbCrLf & _
-           "成功匹配并更新了 " & matchCount & " 条记录。" & vbCrLf & _
+           "成功匹配并更新了 " & matchCount & " 条筛选记录。" & vbCrLf & _
            "用时: " & Format(elapsedTime, "0.00") & " 秒", vbInformation
 
     Exit Sub
 
 ErrorHandler:
-    ' 确保发生错误时关闭数据库连接
+    Application.EnableEvents = True
+    Application.Calculation = xlCalculationAutomatic
+    Application.ScreenUpdating = True
     On Error Resume Next
-    If Not rs Is Nothing Then
-        If rs.State = 1 Then rs.Close
-    End If
-    If Not cn Is Nothing Then
-        If cn.State = 1 Then cn.Close
-    End If
+    If Not rs Is Nothing Then If rs.State = 1 Then rs.Close
+    If Not cn Is Nothing Then If cn.State = 1 Then cn.Close
     On Error GoTo 0
-
     MsgBox "提取Access数据时发生异常: " & Err.Description, vbCritical
 End Sub