'=====================================================================
' 模块名: ErrorAnalysisModule
' 功能: BOM匹配异常分析模块，仅提取报错订单，拆分多行，并自动回溯"未匹配参数"
' 特性: 采用"特征权重算法"解决模糊平局(Tie)导致的参数误报问题
'=====================================================================

Option Explicit

' 提取条件配置
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能"
' 指定输出[BOM匹配异常报表]的表头所在行号
Private Const OUTPUT_HEADER_ROW As Long = 10

'=====================================================================
' 过程: GenerateErrorAnalysisReport
' 功能: 批量处理产品型号，输出BOM匹配异常报表
'=====================================================================
Public Sub GenerateErrorAnalysisReport()
    On Error GoTo ErrorHandler

    Dim startTime As Double
    startTime = Timer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' 获取工作表
    Dim orderSheet As Worksheet
    Dim bomSheet As Worksheet
    Dim outputSheet 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

    ' 获取或创建输出表
    Set outputSheet = CreateErrorOutputSheet()
    WriteOutputHeader outputSheet

    ' 获取筛选后的订单数据
    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

    Dim sourceDataArr As Variant
    sourceDataArr = orderSheet.Range("A2:F" & lastRow).value

    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 regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Global = True
    regEx.IgnoreCase = True
    ' 匹配如 azxs=A0, fjgn!=N1 这样的条件结构
    regEx.Pattern = "(azxs|bkxs|gclj|jycz|lcfw|fjgn)\s*(!=|=)\s*([A-Za-z0-9_]+)"

    Dim outputData As Collection
    Set outputData = New Collection

    Dim cell As Range
    Dim arrIndex As Long
    Dim totalProcessed As Long
    Dim errorOrdersCount As Long
    Dim errorRowsCount As Long

    totalProcessed = 0
    errorOrdersCount = 0
    errorRowsCount = 0

    ' 遍历可见订单
    For Each cell In visibleRange
        arrIndex = cell.row - 1

        Dim totalQueueNum As String
        Dim orderNumber As String
        Dim modelString As String
        Dim componentPriority As String

        totalQueueNum = Trim(sourceDataArr(arrIndex, 1))
        orderNumber = Trim(sourceDataArr(arrIndex, 2))
        modelString = Trim(sourceDataArr(arrIndex, 3))
        componentPriority = Trim(sourceDataArr(arrIndex, 6))

        If modelString <> "" Then
            totalProcessed = totalProcessed + 1

            ' 解析并匹配BOM
            Dim parser As ProductModelParser
            Set parser = New ProductModelParser

            Dim hasError As Boolean
            hasError = False
            Dim errors As String
            errors = ""

            If Not parser.Parse(modelString) Then
                hasError = True
                errors = "型号解析失败: " & parser.ErrorMessage
            Else
                ' 提取逻辑
                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 matchedItems As Collection
                Set matchedItems = BomExtractor.ExtractBom(parser.conditions)

                errors = BomExtractor.GetErrorSummary()
                If errors <> "" Or matchedItems.count = 0 Then
                    hasError = True
                    If errors = "" And matchedItems.count = 0 Then
                        errors = "完全未匹配到物料"
                    End If
                End If

                ' 深度检查BOM行自身的报错（如"匹配到多条"）
                Dim item As BomItem
                For Each item In matchedItems
                    If item.MatchError <> "" Then
                        hasError = True
                        errors = errors & item.category & ":" & item.MatchError & ";"
                    End If
                Next item
            End If

            ' 如果存在错误，拆分为多行并寻找未匹配参数
            If hasError Then
                errorOrdersCount = errorOrdersCount + 1

                Dim errArray() As String
                errArray = Split(errors, ";")
                Dim i As Long

                For i = LBound(errArray) To UBound(errArray)
                    Dim singleError As String
                    singleError = Trim(errArray(i))

                    If singleError <> "" Then
                        Dim unmatchedValues As String
                        unmatchedValues = "无法精准定位:无法精准定位"

                        ' 如果是型号解析失败，跳过溯源
                        If InStr(singleError, "型号解析失败") = 0 And InStr(singleError, "完全未匹配到物料") = 0 Then
                            Dim targetCategory As String
                            targetCategory = ExtractCategoryName(singleError)

                            If targetCategory <> "" Then
                                ' 核心：调用带权重的重合度算法定位冲突参数(通过 | 分隔，内部用 : 分隔键值)
                                unmatchedValues = FindUnmatchedParameter(targetCategory, parser.conditions, BomExtractor.GetAllItems(), regEx)
                            End If
                        End If

                        ' ---> 拆分未匹配参数，避免糅合在一起
                        Dim unmatchArr() As String
                        unmatchArr = Split(unmatchedValues, "|")

                        Dim j As Long
                        For j = LBound(unmatchArr) To UBound(unmatchArr)
                            Dim singleUnmatch As String
                            singleUnmatch = Trim(unmatchArr(j))
                            If singleUnmatch <> "" Then
                                Dim uParam As String
                                Dim uValue As String
                                Dim colonPos As Long
                                colonPos = InStr(singleUnmatch, ":")

                                ' 拆分键和值
                                If colonPos > 0 Then
                                    uParam = Left(singleUnmatch, colonPos - 1)
                                    uValue = Mid(singleUnmatch, colonPos + 1)
                                Else
                                    uParam = singleUnmatch
                                    uValue = singleUnmatch
                                End If

                                outputData.Add CreateErrorRowArray(totalQueueNum, orderNumber, modelString, parser.conditions, uParam, uValue, singleError)
                                errorRowsCount = errorRowsCount + 1
                            End If
                        Next j
                    End If
                Next i
            End If
        End If
    Next cell

    ' 批量写入数据
    If outputData.count > 0 Then
        WriteBatchData outputSheet, outputData
    Else
        MsgBox "太棒了！所选订单均完美匹配BOM，未发现任何异常。", vbInformation
    End If

    ' 格式化表格
    FormatOutputSheet outputSheet

    RestoreAppStatus
    Dim elapsedTime As Double
    elapsedTime = Timer - startTime

    MsgBox "异常分析完成!" & vbCrLf & _
           "共检查订单: " & totalProcessed & vbCrLf & _
           "发现异常订单: " & errorOrdersCount & vbCrLf & _
           "生成异常明细: " & errorRowsCount & " 行" & vbCrLf & _
           "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation

    outputSheet.Activate
    Exit Sub

ErrorHandler:
    RestoreAppStatus
    MsgBox "异常分析发生错误: " & Err.Description, vbCritical
End Sub

'=====================================================================
' 核心算法: FindUnmatchedParameter (带权重的最大特征重合度算法)
' 功能: 分析BOM库，找出与当前订单特征最相似的物料，并提取冲突(未匹配)的参数值
'=====================================================================
Private Function FindUnmatchedParameter(category As String, productConds As Object, allBomItems As Collection, regEx As Object) As String
    ' 使用 Long 类型，因为加入权重后得分会超过 Integer 上限
    Dim maxScore As Long
    maxScore = -1
    Dim bestConflictKeys As String
    bestConflictKeys = ""

    Dim item As BomItem

    ' 遍历BOM库中同类别的所有物料
    For Each item In allBomItems
        If item.category = category And Trim(item.SelectCondition) <> "" Then

            Dim allowed As Object
            Set allowed = CreateObject("Scripting.Dictionary")
            Dim forbidden As Object
            Set forbidden = CreateObject("Scripting.Dictionary")

            ' 使用正则提取该物料的所有约束条件 (如 azxs=A0)
            Dim matches As Object
            Set matches = regEx.Execute(item.SelectCondition)

            Dim match As Object
            For Each match In matches
                Dim k As String, op As String, v As String
                k = match.SubMatches(0)
                op = Trim(match.SubMatches(1))
                v = Trim(match.SubMatches(2))

                If op = "=" Then
                    If Not allowed.Exists(k) Then allowed(k) = "|"
                    allowed(k) = allowed(k) & v & "|"
                ElseIf op = "!=" Or op = "<>" Then
                    If Not forbidden.Exists(k) Then forbidden(k) = "|"
                    forbidden(k) = forbidden(k) & v & "|"
                End If
            Next match

            ' 合并出现过的所有参数键
            Dim allRuleKeys As Object
            Set allRuleKeys = CreateObject("Scripting.Dictionary")

            Dim vKey As Variant
            For Each vKey In allowed.Keys: allRuleKeys(vKey) = True: Next vKey
            For Each vKey In forbidden.Keys: allRuleKeys(vKey) = True: Next vKey

            Dim currentScore As Long
            currentScore = 0
            Dim currentConflicts As String
            currentConflicts = ""

            ' 计算该物料与实际订单参数的重合度得分
            Dim keyVar As Variant
            For Each keyVar In allRuleKeys.Keys
                Dim keyStr As String
                keyStr = CStr(keyVar)

                Dim prodVal As String
                If productConds.Exists(keyStr) Then prodVal = productConds(keyStr) Else prodVal = ""

                Dim isMatch As Boolean
                isMatch = False

                If allowed.Exists(keyStr) Then
                    ' 如果实际值包含在允许值中，则得分
                    If InStr(allowed(keyStr), "|" & prodVal & "|") > 0 Then
                        isMatch = True
                    End If
                ElseIf forbidden.Exists(keyStr) Then
                    ' 如果没有允许值限制，只有禁止值限制，且实际值不在禁止值中，则得分
                    If InStr(forbidden(keyStr), "|" & prodVal & "|") = 0 Then
                        isMatch = True
                    End If
                End If

                If isMatch Then
                    ' 【核心修改】引入特征权重，让系统具备业务直觉
                    currentScore = currentScore + GetFeatureWeight(keyStr)
                Else
                    currentConflicts = currentConflicts & keyStr & ","
                End If
            Next keyVar

            ' 更新最高得分记录
            If currentScore > maxScore Then
                maxScore = currentScore
                bestConflictKeys = currentConflicts
            ElseIf currentScore = maxScore And currentScore > 0 Then
                ' 如果权重得分依然相同，合并所有可能的冲突原因
                Dim keysArray() As String
                keysArray = Split(currentConflicts, ",")
                Dim cKey As Variant
                For Each cKey In keysArray
                    If Trim(cKey) <> "" And InStr(bestConflictKeys, cKey & ",") = 0 Then
                        bestConflictKeys = bestConflictKeys & cKey & ","
                    End If
                Next cKey
            End If

        End If
    Next item

    ' 将最高分的冲突Key翻译为实际的参数值
    If bestConflictKeys <> "" Then
        Dim resultStr As String
        resultStr = ""
        Dim finalKeys() As String
        finalKeys = Split(bestConflictKeys, ",")

        Dim fKey As Variant
        For Each fKey In finalKeys
            If Trim(fKey) <> "" Then
                Dim actVal As String
                If productConds.Exists(fKey) Then actVal = productConds(fKey) Else actVal = "无值"

                ' 使用 | 作为条目分隔符，使用 : 分隔键和值
                Dim pairStr As String
                pairStr = fKey & ":" & actVal

                If resultStr = "" Then
                    resultStr = pairStr
                Else
                    If InStr("|" & resultStr & "|", "|" & pairStr & "|") = 0 Then
                        resultStr = resultStr & "|" & pairStr
                    End If
                End If
            End If
        Next fKey

        If resultStr <> "" Then
            FindUnmatchedParameter = resultStr
        Else
            FindUnmatchedParameter = "无法精准定位:无法精准定位"
        End If
    Else
        FindUnmatchedParameter = "无法精准定位:无法精准定位"
    End If
End Function

'=====================================================================
' 辅助函数: GetFeatureWeight
' 功能: 获取字段的匹配权重，严格保证高优先级特征的决定性
'=====================================================================
Private Function GetFeatureWeight(keyStr As String) As Long
    Select Case LCase(Trim(keyStr))
        Case "azxs"
            GetFeatureWeight = 10000 ' 安装形式 - 决定物理结构，最重要
        Case "bkxs"
            GetFeatureWeight = 1000  ' 表壳形式
        Case "gclj"
            GetFeatureWeight = 100   ' 过程连接
        Case "jycz"
            GetFeatureWeight = 50    ' 接液材质
        Case "lcfw"
            GetFeatureWeight = 10    ' 量程范围
        Case "fjgn"
            GetFeatureWeight = 1     ' 附加功能
        Case Else
            GetFeatureWeight = 0
    End Select
End Function

'=====================================================================
' 辅助函数: ExtractCategoryName
' 功能: 从报错文本如 "必需类别[部件]未匹配" 中提取出 "部件"
'=====================================================================
Private Function ExtractCategoryName(errorMsg As String) As String
    Dim startPos As Long
    Dim endPos As Long
    startPos = InStr(errorMsg, "[")
    endPos = InStr(errorMsg, "]")

    If startPos > 0 And endPos > startPos Then
        ExtractCategoryName = Mid(errorMsg, startPos + 1, endPos - startPos - 1)
    Else
        ExtractCategoryName = ""
    End If
End Function

'=====================================================================
' 过程: WriteOutputHeader
'=====================================================================
Private Sub WriteOutputHeader(ws As Worksheet)
    Dim col As Long
    col = 1

    ws.Cells(OUTPUT_HEADER_ROW, col).value = "总排号": col = col + 1
    ws.Cells(OUTPUT_HEADER_ROW, col).value = "生产订单号": col = col + 1
    ws.Cells(OUTPUT_HEADER_ROW, col).value = "产品型号": col = col + 1

    Dim configs() As String
    configs = Split(CONDITION_CONFIG, "|")
    Dim i As Long
    For i = LBound(configs) To UBound(configs)
        ws.Cells(OUTPUT_HEADER_ROW, col).value = Trim(Split(configs(i), ",")(1))
        col = col + 1
    Next i

    ws.Cells(OUTPUT_HEADER_ROW, col).value = "未匹配参数": col = col + 1
    ws.Cells(OUTPUT_HEADER_ROW, col).value = "未匹配参数值": col = col + 1
    ws.Cells(OUTPUT_HEADER_ROW, col).value = "提取备注": col = col + 1
End Sub

'=====================================================================
' 函数: CreateErrorRowArray
' 功能: 构建输出的一行数据
'=====================================================================
Private Function CreateErrorRowArray(totalQueueNum As String, orderNumber As String, _
                                     modelStr As String, conditions As Object, _
                                     unmatchedParam As String, unmatchedValue As String, errorNote As String) As Variant()
    Dim configs() As String
    configs = Split(CONDITION_CONFIG, "|")

    Dim totalCols As Long
    totalCols = 3 + UBound(configs) - LBound(configs) + 1 + 3

    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) = modelStr: col = col + 1

    Dim i As Long
    For i = LBound(configs) To UBound(configs)
        Dim key As String
        key = Trim(Split(configs(i), ",")(0))
        If conditions.Exists(key) Then
            rowData(col) = conditions(key)
        Else
            rowData(col) = ""
        End If
        col = col + 1
    Next i

    rowData(col) = unmatchedParam: col = col + 1
    rowData(col) = unmatchedValue: col = col + 1
    rowData(col) = errorNote: col = col + 1

    CreateErrorRowArray = rowData
End Function

'=====================================================================
' 过程: WriteBatchData
'=====================================================================
Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
    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, 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

    ' 数据从表头的下一行开始写入
    ws.Cells(OUTPUT_HEADER_ROW + 1, 1).Resize(rowCount, colCount).value = resultData
End Sub

'=====================================================================
' 辅助过程
'=====================================================================
Private Function GetOrderSheet() As Worksheet
    On Error Resume Next
    Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单")
    If GetOrderSheet Is Nothing Then Set GetOrderSheet = ActiveSheet
    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

Private Function CreateErrorOutputSheet() As Worksheet
    Dim wsName As String
    wsName = "BOM匹配异常报表"
    On Error Resume Next
    Set CreateErrorOutputSheet = ThisWorkbook.Worksheets(wsName)
    On Error GoTo 0

    If CreateErrorOutputSheet Is Nothing Then
        Set CreateErrorOutputSheet = ThisWorkbook.Worksheets.Add
        CreateErrorOutputSheet.Name = wsName
    Else
        ' 只清空表头及其以下的数据，保留表头以上的可能存在的内容
        CreateErrorOutputSheet.Rows(OUTPUT_HEADER_ROW & ":" & CreateErrorOutputSheet.Rows.count).Clear
    End If
End Function

Private Sub FormatOutputSheet(ws As Worksheet)
    On Error Resume Next
    With ws.Rows(OUTPUT_HEADER_ROW)
        .Font.Bold = True
        .Interior.Color = RGB(244, 176, 132) ' 橙色背景，突出异常属性
        .HorizontalAlignment = xlCenter
    End With

    ' 将"未匹配参数"列和"未匹配参数值"列加粗显示，颜色标红
    Dim unmatchValCol As Long
    unmatchValCol = ws.Cells(OUTPUT_HEADER_ROW, ws.Columns.count).End(xlToLeft).Column - 1
    Dim unmatchParamCol As Long
    unmatchParamCol = unmatchValCol - 1

    If unmatchParamCol > 0 Then
        ws.Columns(unmatchParamCol).Font.Color = RGB(255, 0, 0)
        ws.Columns(unmatchParamCol).Font.Bold = True
        ws.Columns(unmatchValCol).Font.Color = RGB(255, 0, 0)
        ws.Columns(unmatchValCol).Font.Bold = True
    End If

    On Error GoTo 0
End Sub

Private Sub RestoreAppStatus()
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub