AutoBOM/VBA_BOMConverter/Modules/M09_BOMExtractor.bas

' ==============================================================================
' 模块: M09_BOMExtractor
' 职责: BOM自动提取系统的主流程编排和结果输出
'
' 主要流程:
'   1. 读取输入工作表中的产品型号列表
'   2. 打开BOM库.xlsx文件
'   3. 对于每个产品型号:
'      a. 解析型号，提取参数（M06_ModelParser）
'      b. 遍历BOM库工作表，匹配物料（M07_BOMMatcher）
'      c. 特殊处理"部件"物料（M08_ComponentProcessor）
'      d. 验证部件组合规则
'      e. 生成输出行
'   4. 将结果写入"BOM提取结果"工作表
'   5. 生成错误报告
'
' 输出格式:
'   - 纵向展开格式，每个物料一行
'   - 列: 原始产品型号, azxs, bkxs, gclj, jycz, lcfw, fjgn,
'          物料类型, 物料名称, 物料编码, 物料数量, 提取备注
' ==============================================================================
Option Explicit

' 模块级变量
Private g_Logger As clsErrorLogger
Private g_BOMWorkbook As Workbook

' ------------------------------------------------------------------------------
' 主入口: 运行BOM提取流程
'
' 输入: 无（从活动工作簿读取输入）
'
' 输出:
'   String - 处理结果消息
'
' 流程:
'   1. 初始化环境
'   2. 读取输入产品型号
'   3. 打开BOM库文件
'   4. 处理每个产品型号
'   5. 写入结果到工作表
'   6. 生成错误报告
'
' 示例调用:
'   Dim result As String
'   result = M09_BOMExtractor.RunBOMExtraction()
'   MsgBox result
' ------------------------------------------------------------------------------
Public Function RunBOMExtraction() As String
    On Error GoTo MainErrorHandler

    ' 初始化
    Set g_Logger = New clsErrorLogger
    Set g_BOMWorkbook = Nothing

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    ' 步骤1: 检查输入工作表
    Dim wsInput As Worksheet
    Set wsInput = ThisWorkbook.Worksheets("产品型号")

    If wsInput Is Nothing Then
        RunBOMExtraction = "错误：未找到输入工作表。工作表名称应包含'" & INPUT_COL_MODEL & "'或'" & INPUT_COL_PRODUCT_MODEL & "'。"
        GoTo ExitHandler
    End If

    Application.StatusBar = "正在读取输入数据..."

    ' 步骤2: 读取输入产品型号
    Dim inputModels As Variant
    inputModels = ReadInputModels(wsInput)

    If IsEmpty(inputModels) Then
        RunBOMExtraction = "错误：未找到产品型号数据。请检查工作表中是否有数据。"
        GoTo ExitHandler
    End If

    ' 步骤3: 打开BOM库文件
    Application.StatusBar = "正在打开BOM库文件..."

    Set g_BOMWorkbook = OpenBOMLibrary()

    If g_BOMWorkbook Is Nothing Then
        RunBOMExtraction = "错误：无法打开BOM库文件。请确保[" & BOMLIB_FILENAME & "]与当前工作簿在同一目录下。"
        GoTo ExitHandler
    End If

    ' 初始化各模块
    M06_ModelParser.InitModelParser g_Logger
    M07_BOMMatcher.InitBOMMatcher g_Logger
    M08_ComponentProcessor.InitComponentProcessor g_Logger

    ' 步骤4: 处理每个产品型号
    Application.StatusBar = "正在处理产品型号..."

    Dim allResults As Collection
    Set allResults = New Collection

    Dim i As Long
    Dim totalModels As Long
    totalModels = UBound(inputModels, 1)

    For i = LBound(inputModels, 1) To UBound(inputModels, 1)
        ' 进度更新
        If i Mod 10 = 0 Then
            Dim pct As Long
            pct = CLng((i / totalModels) * 100)
            Application.StatusBar = "正在处理: " & pct & "% | 型号: " & i & "/" & totalModels
            DoEvents
        End If

        ' 处理单个型号
        Dim modelString As String
        modelString = CStr(inputModels(i, 1))

        Dim modelResults As Collection
        Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger)

        ' 合并结果
        Dim result As Variant
        For Each result In modelResults
            allResults.Add result
        Next result
    Next i

    ' 步骤5: 写入结果到工作表
    Application.StatusBar = "正在写入结果..."

    Dim wsOutput As Worksheet
    Set wsOutput = WriteExtractionResults(allResults)

    ' 步骤6: 生成错误报告
    If g_Logger.HasErrors Then
        g_Logger.PrintReport ActiveWorkbook
    End If

    ' 关闭BOM库文件
    If Not g_BOMWorkbook Is Nothing Then
        g_BOMWorkbook.Close SaveChanges:=False
        Set g_BOMWorkbook = Nothing
    End If

    ' 构建返回消息
    Dim successCount As Long
    Dim errorCount As Long
    successCount = 0
    errorCount = 0

    For Each result In allResults
        If Len(CStr(result(12))) = 0 Then  ' 第12列是备注
            successCount = successCount + 1
        Else
            errorCount = errorCount + 1
        End If
    Next result

    Dim msg As String
    msg = "BOM提取完成！" & vbCrLf & _
           "处理型号数: " & totalModels & vbCrLf & _
           "提取物料数: " & allResults.count & vbCrLf & _
           "成功数: " & successCount & vbCrLf & _
           "异常数: " & errorCount

    If g_Logger.HasErrors Then
        msg = msg & vbCrLf & vbCrLf & "发现错误，已生成错误报告工作表。"
    End If

    RunBOMExtraction = msg
    GoTo ExitHandler

MainErrorHandler:
    RunBOMExtraction = "发生运行时错误: " & Err.Description & " (错误号: " & Err.Number & ")"

ExitHandler:
    ' 清理
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    ' 确保关闭BOM库文件
    If Not g_BOMWorkbook Is Nothing Then
        On Error Resume Next
        g_BOMWorkbook.Close SaveChanges:=False
        On Error GoTo 0
        Set g_BOMWorkbook = Nothing
    End If
End Function

' ------------------------------------------------------------------------------
' 获取输入工作表
'
' 输入: 无（从活动工作簿查找）
'
' 输出:
'   Worksheet - 包含产品型号列的工作表
'
' 逻辑:
'   - 优先查找名为"产品型号"的工作表
'   - 如果不存在，查找包含"型号"或"产品型号"列的工作表
' ------------------------------------------------------------------------------
Private Function GetInputWorksheet() As Worksheet
    On Error Resume Next

    ' 方法1: 查找名为"产品型号"的工作表
    Set GetInputWorksheet = ActiveWorkbook.Sheets(INPUT_COL_PRODUCT_MODEL)

    If Not GetInputWorksheet Is Nothing Then
        Exit Function
    End If

    ' 方法2: 查找包含"型号"列的工作表
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        Dim headerCell As Range
        Set headerCell = ws.Rows(1).Find(INPUT_COL_MODEL, LookAt:=xlWhole, MatchCase:=False)

        If Not headerCell Is Nothing Then
            Set GetInputWorksheet = ws
            Exit Function
        End If

        Set headerCell = ws.Rows(1).Find(INPUT_COL_PRODUCT_MODEL, LookAt:=xlWhole, MatchCase:=False)

        If Not headerCell Is Nothing Then
            Set GetInputWorksheet = ws
            Exit Function
        End If
    Next ws

    Set GetInputWorksheet = Nothing
    On Error GoTo 0
End Function

' ------------------------------------------------------------------------------
' 读取输入产品型号
'
' 输入:
'   ws - 输入工作表
'
' 输出:
'   Variant - 二维数组，包含产品型号列表
'
' 注意:
'   - 自动查找"型号"或"产品型号"列
'   - 从第2行开始读取（第1行是表头）
' ------------------------------------------------------------------------------
Private Function ReadInputModels(ByVal ws As Worksheet) As Variant
    On Error GoTo ErrorHandler

    ' 查找型号列
    Dim headerCell As Range
    Set headerCell = ws.Rows(1).Find(INPUT_COL_PRODUCT_MODEL, LookAt:=xlPart, MatchCase:=False)

    If headerCell Is Nothing Then
        Set headerCell = ws.Rows(1).Find(INPUT_COL_MODEL, LookAt:=xlPart, MatchCase:=False)
    End If

    If headerCell Is Nothing Then
        ReadInputModels = Empty
        Exit Function
    End If

    Dim colIdx As Long
    colIdx = headerCell.Column

    ' 查找最后一行
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.count, colIdx).End(xlUp).row

    If lastRow < 2 Then
        ReadInputModels = Empty
        Exit Function
    End If

    ' 读取数据到数组
    ReadInputModels = ws.Range(ws.Cells(2, colIdx), ws.Cells(lastRow, colIdx)).Value
    Exit Function

ErrorHandler:
    ReadInputModels = Empty
End Function

' ------------------------------------------------------------------------------
' 处理单个产品型号
'
' 输入:
'   modelString - 产品型号字符串
'   bomWb - BOM库工作簿
'   logger - 错误记录器
'
' 输出:
'   Collection - 提取结果集合
'   每个元素是一个数组，包含12列数据
'
' 流程:
'   1. 解析型号，提取参数
'   2. 匹配所有物料类型
'   3. 验证部件组合
'   4. 生成输出行
' ------------------------------------------------------------------------------
Private Function ProcessSingleModel( _
    ByVal modelString As String, _
    ByVal bomWb As Workbook, _
    ByVal logger As clsErrorLogger _
) As Collection
    On Error GoTo ErrorHandler

    Dim results As Collection
    Set results = New Collection

    ' 步骤1: 解析型号
    Dim params As Object
    Set params = M06_ModelParser.ParseProductModel(modelString)

    ' 检查解析是否成功
    If params.count = 0 Then
        ' 解析失败，添加错误行
        results.Add GenerateErrorRow(modelString, "型号解析失败：型号格式不正确或缺少必要字段")
        Set ProcessSingleModel = results
        Exit Function
    End If

    ' 步骤2: 匹配所有物料类型
    Dim allMaterials As Collection
    Set allMaterials = MatchAllMaterialTypes(params, bomWb, logger)

    ' 步骤3: 验证部件组合
    Dim validation As Object
    Set validation = M08_ComponentProcessor.ValidateComponentCombination(allMaterials)

    ' 步骤4: 生成输出行
    Dim remarks As String
    remarks = ""

    If Not validation("valid") Then
        remarks = validation("message")
    End If

    Dim mat As Variant
    For Each mat In allMaterials
        Dim outputRow As Variant
        outputRow = GenerateMaterialRow(modelString, params, mat, remarks)
        results.Add outputRow
    Next mat

    ' 如果没有匹配到任何物料，添加错误行
    If allMaterials.count = 0 Then
        results.Add GenerateErrorRow(modelString, "未匹配到任何物料")
    End If

    Set ProcessSingleModel = results
    Exit Function

ErrorHandler:
    If Not logger Is Nothing Then
        logger.Record 0, "M09.ProcessSingleModel", "SystemError", _
            "处理型号[" & modelString & "]失败: " & Err.Description, ""
    End If

    results.Add GenerateErrorRow(modelString, "系统错误: " & Err.Description)
    Set ProcessSingleModel = results
End Function

' ------------------------------------------------------------------------------
' 匹配所有物料类型
'
' 输入:
'   params - 参数字典
'   bomWb - BOM库工作簿
'   logger - 错误记录器
'
' 输出:
'   Collection - 所有匹配到的物料集合
'
' 逻辑:
'   - 遍历BOM库中的所有工作表
'   - 对每个工作表尝试匹配
'   - "部件"工作表特殊处理（调用M08_ComponentProcessor）
'   - 其他工作表使用M07_BOMMatcher匹配
' ------------------------------------------------------------------------------
Private Function MatchAllMaterialTypes( _
    ByVal params As Object, _
    ByVal bomWb As Workbook, _
    ByVal logger As clsErrorLogger _
) As Collection
    On Error GoTo ErrorHandler

    Dim allMaterials As Collection
    Set allMaterials = New Collection

    ' 遍历BOM库中的所有工作表
    Dim ws As Worksheet
    For Each ws In bomWb.Worksheets
        Dim sheetName As String
        sheetName = ws.Name

        Debug.Print "=== 处理工作表: [" & sheetName & "] ==="

        ' "部件"工作表特殊处理
        If sheetName = BOMLIB_SHEET_COMPONENT Then
            Debug.Print "  -> 使用部件处理逻辑"

            Dim componentMaterials As Collection
            Set componentMaterials = M08_ComponentProcessor.ProcessComponentRecord( _
                ws, params, logger)

            Debug.Print "  -> 返回物料数: " & componentMaterials.count

            Dim compMat As Variant
            For Each compMat In componentMaterials
                Debug.Print "     [" & compMat("materialType") & "] 名称=[" & compMat("materialName") & "] 编码=[" & compMat("materialCode") & "]"
                allMaterials.Add compMat
            Next compMat
        Else
            ' 其他工作表使用标准匹配逻辑
            ' 匹配记录
            Dim matchResult As Object
            Set matchResult = M07_BOMMatcher.MatchBOMRecord(ws, params)

            Debug.Print "  -> 匹配结果: " & matchResult("success") & ", 行数: " & matchResult("rowCount")

            ' 如果匹配成功，提取物料信息
            If matchResult("success") Then
                Dim rowNum As Long
                rowNum = matchResult("rowNums")(1)
                Debug.Print "  -> 匹配行号: " & rowNum

                Dim headerMap As Object
                Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(ws)

                Debug.Print "  -> 表头映射键数: " & headerMap.count

                Dim materialInfo As Object
                Set materialInfo = M07_BOMMatcher.ExtractMaterialInfo(ws, rowNum, headerMap)

                Debug.Print "  -> 提取结果: 名称=[" & materialInfo("materialName") & "] 编码=[" & materialInfo("materialCode") & "] 数量=[" & materialInfo("materialQty") & "]"

                If Not materialInfo Is Nothing Then
                    allMaterials.Add materialInfo
                    Debug.Print "  -> 已添加到物料集合"
                Else
                    Debug.Print "  -> ERROR: materialInfo为Nothing"
                End If
            Else
                ' 匹配失败，记录错误（但不中断处理）
                If matchResult("rowCount") = 0 Then
                    logger.Record 0, "M09.MatchAllMaterialTypes", "BOMMatchError", _
                        sheetName & " " & matchResult("message"), ""
                    Debug.Print "  -> 未匹配到记录"
                End If
            End If
        End If
        Debug.Print ""
    Next ws

    Set MatchAllMaterialTypes = allMaterials
    Exit Function

ErrorHandler:
    If Not logger Is Nothing Then
        logger.Record 0, "M09.MatchAllMaterialTypes", "SystemError", _
            "匹配物料类型失败: " & Err.Description, ""
    End If
    Set MatchAllMaterialTypes = allMaterials
End Function

' ------------------------------------------------------------------------------
' 生成单行输出数据
'
' 输入:
'   modelString - 原始产品型号
'   params - 参数字典
'   material - 物料信息字典
'   remarks - 备注信息
'
' 输出:
'   Variant - 包含12列数据的数组
'
' 列定义:
'   1: 原始产品型号
'   2: azxs
'   3: bkxs
'   4: gclj
'   5: jycz
'   6: lcfw
'   7: fjgn
'   8: 物料类型
'   9: 物料名称
'   10: 物料编码
'   11: 物料数量
'   12: 提取备注
' ------------------------------------------------------------------------------
Private Function GenerateMaterialRow( _
    ByVal modelString As String, _
    ByVal params As Object, _
    ByVal material As Object, _
    ByVal remarks As String _
) As Variant
    Dim result(1 To 12) As Variant

    ' 第1列: 原始产品型号
    result(1) = modelString

    ' 第2-7列: 参数值
    result(2) = GetParamValue(params, "azxs")
    result(3) = GetParamValue(params, "bkxs")
    result(4) = GetParamValue(params, "gclj")
    result(5) = GetParamValue(params, "jycz")
    result(6) = GetParamValue(params, "lcfw")
    result(7) = GetParamValue(params, "fjgn")

    ' 第8-11列: 物料信息
    result(8) = GetMaterialValue(material, "materialType")
    result(9) = GetMaterialValue(material, "materialName")
    result(10) = GetMaterialValue(material, "materialCode")
    result(11) = GetMaterialValue(material, "materialQty")

    ' 第12列: 备注
    result(12) = remarks & " " & GetMaterialValue(material, "remarks")
    result(12) = Trim(result(12))

    GenerateMaterialRow = result
End Function

' ------------------------------------------------------------------------------
' 生成错误行
'
' 输入:
'   modelString - 原始产品型号
'   errorMessage - 错误消息
'
' 输出:
'   Variant - 包含12列数据的数组（仅型号和备注有值）
' ------------------------------------------------------------------------------
Private Function GenerateErrorRow( _
    ByVal modelString As String, _
    ByVal errorMessage As String _
) As Variant
    Dim result(1 To 12) As Variant
    Dim i As Long

    For i = 1 To 12
        result(i) = ""
    Next i

    result(1) = modelString
    result(12) = "错误: " & errorMessage

    GenerateErrorRow = result
End Function

' ------------------------------------------------------------------------------
' 辅助函数: 从参数字典中获取值
' ------------------------------------------------------------------------------
Private Function GetParamValue(ByVal params As Object, ByVal key As String) As Variant
    If params.Exists(key) Then
        GetParamValue = params(key)
    Else
        GetParamValue = ""
    End If
End Function

' ------------------------------------------------------------------------------
' 辅助函数: 从物料字典中获取值
' ------------------------------------------------------------------------------
Private Function GetMaterialValue(ByVal material As Object, ByVal key As String) As Variant
    If material.Exists(key) Then
        GetMaterialValue = material(key)
    Else
        GetMaterialValue = ""
    End If
End Function

' ------------------------------------------------------------------------------
' 写入提取结果到工作表
'
' 输入:
'   results - 提取结果集合
'
' 输出:
'   Worksheet - 输出工作表
'
' 逻辑:
'   1. 创建或清空"BOM提取结果"工作表
'   2. 写入表头
'   3. 批量写入数据
'   4. 格式化工作表
' ------------------------------------------------------------------------------
Private Function WriteExtractionResults(ByVal results As Collection) As Worksheet
    On Error GoTo ErrorHandler

    Dim ws As Worksheet

    ' 创建或获取工作表
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(OUTPUT_SHEET_NAME)
    On Error GoTo ErrorHandler

    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.count))
        ws.Name = OUTPUT_SHEET_NAME
    Else
        ws.Cells.Clear
    End If

    ' 写入表头
    Dim headers As Variant
    headers = Array("原始产品型号", "azxs", "bkxs", "gclj", "jycz", "lcfw", "fjgn", _
                    "物料类型", "物料名称", "物料编码", "物料数量", "提取备注")

    Dim c As Long
    For c = 1 To 12
        ws.Cells(1, c).Value = headers(c - 1)
    Next c

    ' 格式化表头
    With ws.Range("A1:L1")
        .Font.Bold = True
        .Interior.Color = RGB(217, 217, 217)
        .HorizontalAlignment = xlCenter
    End With

    ' 写入数据
    If results.count > 0 Then
        Dim outputArr() As Variant
        ReDim outputArr(1 To results.count, 1 To 12)

        Dim i As Long
        Dim result As Variant

        For i = 1 To results.count
            result = results(i)

            Dim j As Long
            For j = 1 To 12
                outputArr(i, j) = result(j)
            Next j
        Next i

        ws.Range("A2").Resize(results.count, 12).Value = outputArr

        ' 格式化数据区域
        With ws.Range("A2:L" & (results.count + 1))
            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlThin
        End With

        ' 如果有错误备注，标红
        For i = 1 To results.count
            If Len(CStr(outputArr(i, 12))) > 0 And InStr(CStr(outputArr(i, 12)), "错误") > 0 Then
                ws.Cells(i + 1, 12).Interior.Color = RGB(255, 200, 200)
            End If
        Next i
    End If

    ' 自动调整列宽
    ws.Columns.AutoFit

    ' 冻结首行
    ws.Activate
    ActiveWindow.FreezePanes = False
    ws.Rows(2).Select
    ActiveWindow.FreezePanes = True
    ws.Cells(1, 1).Select

    Set WriteExtractionResults = ws
    Exit Function

ErrorHandler:
    Set WriteExtractionResults = Nothing
End Function

' ------------------------------------------------------------------------------
' 打开BOM库文件
'
' 输入: 无（从当前工作簿目录查找）
'
' 输出:
'   Workbook - BOM库工作簿
'
' 逻辑:
'   1. 获取当前工作簿路径
'   2. 构建BOM库文件路径
'   3. 打开BOM库文件（只读模式）
' ------------------------------------------------------------------------------
Private Function OpenBOMLibrary() As Workbook
    On Error GoTo ErrorHandler

    ' 获取当前工作簿路径
    Dim currentPath As String
    currentPath = ActiveWorkbook.Path

    ' 构建BOM库文件路径
    Dim bomPath As String
    bomPath = currentPath & "\" & BOMLIB_FILENAME

    ' 检查文件是否存在
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Not fso.FileExists(bomPath) Then
        Set OpenBOMLibrary = Nothing
        Exit Function
    End If

    ' 打开BOM库文件（只读）
    Set OpenBOMLibrary = Workbooks.Open(bomPath, ReadOnly:=True)
    Exit Function

ErrorHandler:
    Set OpenBOMLibrary = Nothing
End Function