'===================================================================== ' 模块名: MainModule ' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑 ' 作者: Auto-generated ' 日期: 2025-01-29 '===================================================================== Option Explicit '===================================================================== ' 常量定义 '===================================================================== ' 提取条件配置(可灵活扩展) Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围" '===================================================================== ' 过程: ProcessProductModels ' 功能: 批量处理产品型号并输出结果 ' 说明: 这是主入口程序 '===================================================================== Public Sub ProcessProductModels() On Error GoTo ErrorHandler Dim startTime As Double startTime = Timer ' 准备输入输出 Dim inputSheet As Worksheet Dim outputSheet As Worksheet Dim bomSheet As Worksheet ' 获取工作表 Set inputSheet = GetInputSheet() If inputSheet Is Nothing Then MsgBox "未找到输入工作表,请确保工作簿中有包含订单数据的工作表", vbCritical Exit Sub End If ' 获取BOM库工作表 Set bomSheet = GetBomSheet() If bomSheet Is Nothing Then MsgBox "未找到'平台配置清单'工作表,请确保BOM数据存在", vbCritical Exit Sub End If ' 创建或获取输出工作表 Set outputSheet = CreateOutputSheet() ' 初始化BOM提取器 Dim BomExtractor As BomExtractor Set BomExtractor = New BomExtractor BomExtractor.SetWorksheet bomSheet If Not BomExtractor.LoadBomData Then MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical Exit Sub End If ' 处理每个产品型号 Dim lastRow As Long lastRow = inputSheet.Cells(inputSheet.Rows.Count, 1).End(xlUp).row Dim outputRow As Long outputRow = 2 ' 从第2行开始输出(第1行是表头) ' 写入输出表头 WriteOutputHeader outputSheet Dim i As Long Dim modelString As String Dim processedCount As Long processedCount = 0 ' 假设产品型号在第1列,从第2行开始 For i = 2 To lastRow modelString = Trim(inputSheet.Cells(i, 2).value) If modelString <> "" Then ' 处理单个型号 outputRow = ProcessSingleModel(modelString, BomExtractor, outputSheet, outputRow) processedCount = processedCount + 1 End If Next i ' 格式化输出表 FormatOutputSheet outputSheet Dim elapsedTime As Double elapsedTime = Timer - startTime MsgBox "处理完成!" & vbCrLf & _ "处理型号数: " & processedCount & vbCrLf & _ "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation ' 激活输出表 outputSheet.Activate Exit Sub ErrorHandler: MsgBox "处理异常: " & Err.description, vbCritical End Sub '===================================================================== ' 函数: ProcessSingleModel ' 功能: 处理单个产品型号 ' 参数: modelString - 产品型号字符串 ' bomExtractor - BOM提取器对象 ' outputSheet - 输出工作表 ' startRow - 起始行号 ' 返回: Long - 下一个可用行号 '===================================================================== Private Function ProcessSingleModel(modelString As String, _ BomExtractor As BomExtractor, _ outputSheet As Worksheet, _ startRow As Long) As Long On Error Resume Next Dim currentRow As Long currentRow = startRow ' 解析产品型号 Dim parser As ProductModelParser Set parser = New ProductModelParser Dim extractNote As String extractNote = "" If Not parser.Parse(modelString) Then ' 解析失败 extractNote = "解析失败: " & parser.ErrorMessage WriteOutputRow outputSheet, currentRow, modelString, "", parser.Conditions, extractNote, Nothing ProcessSingleModel = currentRow + 1 Exit Function End If ' 提取BOM Dim matchedItems As collection Set matchedItems = BomExtractor.ExtractBom(parser.Conditions) ' 获取错误信息 Dim bomErrors As String bomErrors = BomExtractor.GetErrorSummary If bomErrors <> "" Then extractNote = bomErrors End If ' 输出结果 If matchedItems.Count = 0 Then ' 没有匹配项 If extractNote = "" Then extractNote = "未匹配到任何物料" End If WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, extractNote, Nothing currentRow = currentRow + 1 Else ' 输出每个匹配的物料 Dim item As BomItem Dim isFirst As Boolean isFirst = True For Each item In matchedItems Dim itemNote As String itemNote = extractNote ' 添加物料特定的错误 If item.MatchError <> "" Then If itemNote <> "" Then itemNote = itemNote & "; " itemNote = itemNote & item.MatchError End If If isFirst Then WriteOutputRow outputSheet, currentRow, modelString, parser.HeaderModel, parser.Conditions, itemNote, item isFirst = False Else WriteOutputRow outputSheet, currentRow, "", "", parser.Conditions, itemNote, item End If currentRow = currentRow + 1 Next item End If ProcessSingleModel = currentRow End Function '===================================================================== ' 过程: WriteOutputHeader ' 功能: 写入输出表头 ' 参数: ws - 工作表对象 '===================================================================== Private Sub WriteOutputHeader(ws As Worksheet) Dim col As Long col = 1 ws.Cells(1, col).value = "产品型号": col = col + 1 ws.Cells(1, col).value = "表头型号": col = col + 1 ' 写入条件字段表头 Dim Conditions() As String Dim labels() As String GetConditionConfig Conditions, labels Dim i As Long For i = LBound(Conditions) To UBound(Conditions) ws.Cells(1, col).value = labels(i) col = col + 1 Next i ' 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 = "66代码": col = col + 1 ws.Cells(1, col).value = "提取备注": col = col + 1 End Sub '===================================================================== ' 过程: WriteOutputRow ' 功能: 写入输出行 ' 参数: ws - 工作表对象 ' row - 行号 ' fullModel - 完整型号 ' headerModel - 表头型号 ' conditions - 条件字典 ' note - 备注 ' item - BOM项(可为Nothing) '===================================================================== Private Sub WriteOutputRow(ws As Worksheet, _ row As Long, _ FullModel As String, _ HeaderModel As String, _ Conditions As Object, _ note As String, _ item As BomItem) Dim col As Long col = 1 ws.Cells(row, col).value = FullModel: col = col + 1 ws.Cells(row, col).value = HeaderModel: col = col + 1 ' 写入条件值 Dim condNames() As String Dim labels() As String GetConditionConfig condNames, labels Dim i As Long For i = LBound(condNames) To UBound(condNames) If Conditions.Exists(condNames(i)) Then ws.Cells(row, col).value = Conditions(condNames(i)) Else ws.Cells(row, col).value = "" End If col = col + 1 Next i ' 写入BOM数据 If Not item Is Nothing Then ws.Cells(row, col).value = item.RowNumber: col = col + 1 ws.Cells(row, col).value = item.Module: col = col + 1 ws.Cells(row, col).value = item.code: col = col + 1 ws.Cells(row, col).value = item.Name: col = col + 1 ws.Cells(row, col).value = item.Quantity: col = col + 1 ws.Cells(row, col).value = item.category: col = col + 1 ws.Cells(row, col).value = item.Code66: col = col + 1 Else col = col + 7 ' 跳过BOM字段 End If ws.Cells(row, col).value = note End Sub '===================================================================== ' 过程: GetConditionConfig ' 功能: 获取条件配置 ' 参数: outNames - 输出条件名称数组 ' outLabels - 输出条件标签数组 '===================================================================== Private Sub GetConditionConfig(ByRef outNames() As String, ByRef outLabels() As String) Dim configs() As String configs = Split(CONDITION_CONFIG, "|") ReDim outNames(LBound(configs) To UBound(configs)) ReDim outLabels(LBound(configs) To UBound(configs)) Dim i As Long Dim parts() As String For i = LBound(configs) To UBound(configs) parts = Split(configs(i), ",") outNames(i) = Trim(parts(0)) outLabels(i) = Trim(parts(1)) Next i End Sub '===================================================================== ' 函数: GetInputSheet ' 功能: 获取输入工作表 ' 返回: Worksheet - 输入工作表对象 '===================================================================== Private Function GetInputSheet() As Worksheet ' 这里假设输入数据在当前活动工作表或名为"订单"的工作表 On Error Resume Next Set GetInputSheet = ThisWorkbook.Worksheets("产品订单") If GetInputSheet Is Nothing Then Set GetInputSheet = ActiveSheet End If On Error GoTo 0 End Function '===================================================================== ' 函数: GetBomSheet ' 功能: 获取BOM工作表 ' 返回: Worksheet - BOM工作表对象 '===================================================================== Private Function GetBomSheet() As Worksheet On Error Resume Next Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单") On Error GoTo 0 End Function '===================================================================== ' 函数: CreateOutputSheet ' 功能: 创建或获取输出工作表 ' 返回: Worksheet - 输出工作表对象 '===================================================================== Private Function CreateOutputSheet() As Worksheet Dim wsName As String wsName = "BOM提取结果" On Error Resume Next Set CreateOutputSheet = ThisWorkbook.Worksheets(wsName) On Error GoTo 0 If CreateOutputSheet Is Nothing Then Set CreateOutputSheet = ThisWorkbook.Worksheets.Add CreateOutputSheet.Name = wsName Else ' 清空现有数据 CreateOutputSheet.Cells.Clear End If End Function '===================================================================== ' 过程: FormatOutputSheet ' 功能: 格式化输出工作表 ' 参数: ws - 工作表对象 '===================================================================== Private Sub FormatOutputSheet(ws As Worksheet) On Error Resume Next ' 设置表头格式 With ws.Rows(1) .Font.Bold = True .Interior.Color = RGB(217, 217, 217) .HorizontalAlignment = xlCenter End With ' ' 自动调整列宽 ' ws.Columns.AutoFit ' ' ' 冻结首行 ' ws.Rows(2).Select ' 'ActiveWindow.FreezePanes = True ' ws.Cells(1, 1).Select On Error GoTo 0 End Sub