diff --git a/VBA/DocumentModules/Sheet9.cls b/VBA/DocumentModules/Sheet9.cls index c7b17b7..404af46 100644 --- a/VBA/DocumentModules/Sheet9.cls +++ b/VBA/DocumentModules/Sheet9.cls @@ -4,7 +4,7 @@ '===================================================================== Private Sub CommandButton1_Click() Call ProcessProductModels - Call ProcessOrdersToBIP + Call ValidateOrderMaterials End Sub '===================================================================== @@ -25,4 +25,8 @@ End Sub Private Sub CommandButton4_Click() ThisWorkbook.Worksheets("产品订单").Range("A2:G10000").ClearContents +End Sub + +Private Sub CommandButton5_Click() + Call ProcessOrdersToBIP End Sub \ No newline at end of file diff --git a/VBA/Modules/OrderValidationModule.bas b/VBA/Modules/OrderValidationModule.bas new file mode 100644 index 0000000..6676e4b --- /dev/null +++ b/VBA/Modules/OrderValidationModule.bas @@ -0,0 +1,217 @@ +'===================================================================== +' 模块名: 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 \ No newline at end of file