AutoBOM/VBA/Modules/MainModule.bas

'=====================================================================
' 模块名: MainModule
' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑
' 特性: [已重构] 支持仅对筛选后的数据进行处理，采用内存极速读取
'=====================================================================

Option Explicit

'=====================================================================
' 常量定义
'=====================================================================
' 提取条件配置(可灵活扩展)
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能"

'=====================================================================
' 过程: ProcessProductModels
' 功能: 批量处理产品型号并输出结果
' 说明: 这是主入口程序
'=====================================================================
Public Sub ProcessProductModels()
    On Error GoTo ErrorHandler

    Dim startTime As Double
    startTime = Timer

    ' 关闭屏幕刷新提升速度
    Application.ScreenUpdating = False

    ' 准备输入输出
    Dim inputSheet As Worksheet
    Dim outputSheet As Worksheet
    Dim bomSheet As Worksheet

    ' 获取工作表
    Set inputSheet = GetInputSheet()
    If inputSheet Is Nothing Then
        Application.ScreenUpdating = True
        MsgBox "未找到输入工作表,请确保工作簿中有包含订单数据的工作表", vbCritical
        Exit Sub
    End If

    ' 获取BOM库工作表
    Set bomSheet = GetBomSheet()
    If bomSheet Is Nothing Then
        Application.ScreenUpdating = True
        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
        Application.ScreenUpdating = True
        MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
        Exit Sub
    End If

    Dim lastRow As Long
    lastRow = inputSheet.Cells(inputSheet.Rows.count, 1).End(xlUp).row

    If lastRow < 2 Then
        Application.ScreenUpdating = True
        MsgBox "[产品订单]工作表中没有数据!", vbExclamation
        Exit Sub
    End If

    ' 【性能核心】将输入数据全量读入内存数组
    Dim sourceDataArr As Variant
    sourceDataArr = inputSheet.Range("A2:F" & lastRow).value

    ' 【筛选核心】获取可见的单元格区域
    Dim visibleRange As Range
    On Error Resume Next
    Set visibleRange = inputSheet.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo ErrorHandler

    If visibleRange Is Nothing Then
        Application.ScreenUpdating = True
        MsgBox "当前筛选状态下没有可见的数据。", vbInformation
        Exit Sub
    End If

    ' 写入输出表头
    WriteOutputHeader outputSheet

    ' 收集所有输出数据
    Dim outputData As Collection
    Set outputData = New Collection

    Dim cell As Range
    Dim arrIndex As Long
    Dim modelString As String
    Dim processedCount As Long

    processedCount = 0

    ' 仅遍历筛选出来的可见行
    For Each cell In visibleRange
        Dim totalQueueNum As String
        Dim orderNumber As String
        Dim componentPriority As String

        ' 将工作表行号映射到数组索引
        arrIndex = cell.row - 1

        ' 从内存数组中极速读取对应字段
        totalQueueNum = Trim(sourceDataArr(arrIndex, 1))     ' A列：总排号
        orderNumber = Trim(sourceDataArr(arrIndex, 2))       ' B列：生产订单号
        modelString = Trim(sourceDataArr(arrIndex, 3))       ' C列：产品型号
        componentPriority = Trim(sourceDataArr(arrIndex, 6)) ' F列：部件优先

        If modelString <> "" Then
            ' 处理单个型号，收集数据
            ProcessSingleModel totalQueueNum, orderNumber, modelString, componentPriority, BomExtractor, outputData
            processedCount = processedCount + 1
        End If
    Next cell

    ' 批量写入数据到工作表
    If outputData.count > 0 Then
        WriteBatchData outputSheet, outputData
    End If

    ' 格式化输出表
    FormatOutputSheet outputSheet

    Dim elapsedTime As Double
    elapsedTime = Timer - startTime

    Application.ScreenUpdating = True

    MsgBox "处理完成!" & vbCrLf & _
           "处理筛选型号数: " & processedCount & vbCrLf & _
           "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation

    ' 激活输出表
    outputSheet.Activate

    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "处理异常: " & Err.Description, vbCritical
End Sub

'=====================================================================
' 过程: ProcessSingleModel
' 功能: 处理单个产品型号，将数据添加到输出集合
' 参数: orderNumber - 生产订单号
'       modelString - 产品型号字符串
'       componentPriority - 部件优先标志（"是"或"否"）
'       bomExtractor - BOM提取器对象
'       outputData - 输出数据集合
'=====================================================================
Private Sub ProcessSingleModel(totalQueueNum As String, _
                               orderNumber As String, _
                               modelString As String, _
                               componentPriority As String, _
                               BomExtractor As BomExtractor, _
                               outputData As Collection)
    On Error Resume Next

    ' 根据部件优先设置排除类别
    BomExtractor.ClearExcludeCategories
    If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
        Dim excludeCats As New Collection
        excludeCats.Add "部件"
        BomExtractor.SetExcludeCategories excludeCats
    End If

    ' 解析产品型号
    Dim parser As ProductModelParser
    Set parser = New ProductModelParser

    Dim extractNote As String
    extractNote = ""

    If Not parser.Parse(modelString) Then
        ' 解析失败
        extractNote = "解析失败: " & parser.ErrorMessage
        outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.conditions, extractNote, Nothing)
        Exit Sub
    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
        outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.conditions, extractNote, Nothing)
    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
                ' 首行保留总排号和订单号
                outputData.Add CreateOutputRowArray(totalQueueNum, orderNumber, modelString, parser.conditions, itemNote, item)
                isFirst = False
            Else
                ' 同一个型号的后续BOM项，总排号和订单号留空以保持报表整洁
                outputData.Add CreateOutputRowArray("", "", modelString, parser.conditions, itemNote, item)
            End If
        Next item
    End If
End Sub

'=====================================================================
' 过程: 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
    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

'=====================================================================
' 函数: CreateOutputRowArray
' 功能: 创建输出行数据的数组
' 参数: orderNumber - 生产订单号
'       FullModel - 完整型号
'       Conditions - 条件字典
'       note - 备注
'       item - BOM项(可为Nothing)
' 返回: Variant() - 行数据数组
'=====================================================================
Private Function CreateOutputRowArray(totalQueueNum As String, _
                                      orderNumber As String, _
                                      FullModel As String, _
                                      conditions As Object, _
                                      note As String, _
                                      item As BomItem) As Variant()
    ' 获取条件配置
    Dim condNames() As String
    Dim labels() As String
    GetConditionConfig condNames, labels

    ' 计算总列数：3 (排号+订单+型号) + 条件数 + 7 (BOM字段减去代号后剩6个 + 1个备注)
    Dim totalCols As Long
    totalCols = 3 + (UBound(condNames) - LBound(condNames) + 1) + 7

    ' 创建数组
    ReDim rowData(1 To totalCols) As Variant

    Dim col As Long
    col = 1

    ' 基础信息
    rowData(col) = totalQueueNum: col = col + 1
    rowData(col) = orderNumber: col = col + 1
    rowData(col) = FullModel: col = col + 1

    ' 写入条件值
    Dim i As Long
    For i = LBound(condNames) To UBound(condNames)
        If conditions.Exists(condNames(i)) Then
            rowData(col) = conditions(condNames(i))
        Else
            rowData(col) = ""
        End If
        col = col + 1
    Next i

    ' 写入BOM数据
    If Not item Is Nothing Then
        rowData(col) = item.RowNumber: col = col + 1
        rowData(col) = item.Module: col = col + 1
        ' rowData(col) = item.code: col = col + 1  <-- 已移除
        rowData(col) = item.Name: col = col + 1
        rowData(col) = item.Quantity: col = col + 1
        rowData(col) = item.category: col = col + 1
        rowData(col) = item.Code66: col = col + 1
    Else
        ' 跳过BOM字段 (原本是7个字段，去掉代号后变成6个字段)
        col = col + 6
    End If

    ' 备注
    rowData(col) = note

    CreateOutputRowArray = rowData
End Function

'=====================================================================
' 过程: WriteBatchData
' 功能: 批量写入数据到工作表
' 参数: ws - 工作表对象
'       outputData - 输出数据集合
'=====================================================================
Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
    ' 如果没有数据，直接返回
    If outputData.count = 0 Then
        Exit Sub
    End If

    ' 获取第一行数据来确定列数
    Dim firstRow As Variant
    firstRow = outputData(1)

    Dim rowCount As Long
    Dim colCount As Long
    rowCount = outputData.count
    colCount = UBound(firstRow) - LBound(firstRow) + 1

    ' 创建二维数组
    Dim resultData() As Variant
    ReDim resultData(1 To rowCount, 1 To colCount)

    ' 填充数据到二维数组
    Dim i As Long
    Dim j As Long
    Dim rowArray As Variant

    For i = 1 To rowCount
        rowArray = outputData(i)
        For j = 1 To colCount
            resultData(i, j) = rowArray(j)
        Next j
    Next i

    ' 一次性写入工作表（从第2行开始）
    ws.Range("A2").Resize(rowCount, colCount).value = resultData
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