'===================================================================== ' 模块名: OrderValidationModule ' 功能: 订单物料有效性检查模块 ' 说明: 检查[产品订单]中可见行的产品型号是否能成功提取BOM。 ' 如果发生任何提取错误或无法匹配物料,则在G列[是否领料]写入"否"。 ' 特性: 采用内存极速读取,仅对筛选后的数据进行处理。 '===================================================================== Option Explicit '===================================================================== ' 过程: ValidateOrderMaterials ' 功能: 批量检查可见订单的BOM提取有效性 '===================================================================== Public Sub ValidateOrderMaterials() On Error GoTo ErrorHandler Dim startTime As Double startTime = Timer ' 提升性能:关闭屏幕更新和自动计算 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' 获取工作表 Dim orderSheet As Worksheet Dim bomSheet As Worksheet Set orderSheet = GetOrderSheet() If orderSheet Is Nothing Then RestoreAppStatus MsgBox "未找到[产品订单]工作表!", vbCritical Exit Sub End If Set bomSheet = GetBomSheet() If bomSheet Is Nothing Then RestoreAppStatus MsgBox "未找到[平台配置清单]工作表!", vbCritical Exit Sub End If ' 初始化BOM提取器 Dim BomExtractor As BomExtractor Set BomExtractor = New BomExtractor BomExtractor.SetWorksheet bomSheet If Not BomExtractor.LoadBomData Then RestoreAppStatus MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical Exit Sub End If ' 写入G列表头 orderSheet.Cells(1, 7).value = "是否领料" Dim lastRow As Long lastRow = orderSheet.Cells(orderSheet.Rows.count, 3).End(xlUp).row If lastRow < 2 Then RestoreAppStatus MsgBox "[产品订单]工作表中没有需要处理的数据!", vbExclamation Exit Sub End If ' 【性能核心】将输入数据全量读入内存数组 (读取A到F列即可) Dim sourceDataArr As Variant sourceDataArr = orderSheet.Range("A2:F" & lastRow).value ' 【筛选核心】获取可见的单元格区域 (A列) 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 RestoreAppStatus MsgBox "当前筛选状态下没有可见的数据。", vbInformation Exit Sub End If Dim cell As Range Dim arrIndex As Long Dim modelString As String Dim componentPriority As String Dim processedCount As Long Dim invalidCount As Long processedCount = 0 invalidCount = 0 ' 仅遍历筛选出来的可见行 For Each cell In visibleRange ' 将工作表行号映射到数组索引 (数据从第2行开始,所以数组索引 = 行号 - 1) arrIndex = cell.row - 1 ' 从内存数组中极速读取所需的关键字段 modelString = Trim(sourceDataArr(arrIndex, 3)) ' C列:产品型号 componentPriority = Trim(sourceDataArr(arrIndex, 6)) ' F列:部件优先 If modelString <> "" Then processedCount = processedCount + 1 ' 调用校验逻辑,判断是否存在BOM提取错误 If IsInvalidOrderBOM(modelString, componentPriority, BomExtractor) Then ' 如果无效/有报错,直接在对应行的第7列(G列)写入"否" ' 正常订单不做任何处理,保留原样 orderSheet.Cells(cell.row, 7).value = "否" invalidCount = invalidCount + 1 End If End If Next cell ' 恢复应用状态 RestoreAppStatus Dim elapsedTime As Double elapsedTime = Timer - startTime MsgBox "有效性检查完成!" & vbCrLf & _ "共检查了 " & processedCount & " 个筛选订单。" & vbCrLf & _ "发现并标记了 " & invalidCount & " 个无效/报错订单。" & vbCrLf & _ "用时: " & Format(elapsedTime, "0.00") & " 秒", vbInformation Exit Sub ErrorHandler: RestoreAppStatus MsgBox "检查订单物料有效性时发生异常: " & Err.Description, vbCritical End Sub '===================================================================== ' 函数: IsInvalidOrderBOM ' 功能: 模拟BOM提取过程,判定该订单是否存在错误 ' 参数: modelString - 产品型号 ' componentPriority - 部件优先标识 ' BomExtractor - 已初始化的BOM提取器对象 ' 返回: Boolean - 只要发生任何错误或未匹配到物料,则返回 True '===================================================================== Private Function IsInvalidOrderBOM(modelString As String, _ componentPriority As String, _ BomExtractor As BomExtractor) As Boolean On Error Resume Next ' 默认认为它是有效的,直到发现错误 IsInvalidOrderBOM = False ' 1. 根据部件优先设置排除类别 BomExtractor.ClearExcludeCategories If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then Dim excludeCats As New Collection excludeCats.Add "部件" BomExtractor.SetExcludeCategories excludeCats End If ' 2. 解析产品型号 Dim parser As ProductModelParser Set parser = New ProductModelParser If Not parser.Parse(modelString) Then ' 解析失败,属于无效订单 IsInvalidOrderBOM = True Exit Function End If ' 3. 提取BOM Dim matchedItems As Collection Set matchedItems = BomExtractor.ExtractBom(parser.conditions) ' 4. 检查 BOM 提取器全局错误日志 If BomExtractor.GetErrorSummary <> "" Then IsInvalidOrderBOM = True Exit Function End If ' 5. 检查是否完全没有匹配到物料 If matchedItems.count = 0 Then IsInvalidOrderBOM = True Exit Function End If ' 6. 深度检查:遍历提取出的每一项,看是否存在子项报错 Dim item As BomItem For Each item In matchedItems If item.MatchError <> "" Then IsInvalidOrderBOM = True Exit Function End If Next item On Error GoTo 0 End Function '===================================================================== ' 辅助过程: RestoreAppStatus ' 功能: 恢复Excel应用程序的状态 '===================================================================== Private Sub RestoreAppStatus() Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub '===================================================================== ' 辅助函数: 获取所需工作表 '===================================================================== Private Function GetOrderSheet() As Worksheet On Error Resume Next Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单") On Error GoTo 0 End Function Private Function GetBomSheet() As Worksheet On Error Resume Next Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单") On Error GoTo 0 End Function