AutoBOM/VBA_BOMConverter/Modules/M07_BOMMatcher.bas

' ==============================================================================
' 模块: M07_BOMMatcher
' 职责: BOM库匹配，根据提取的参数在BOM库中查找匹配的物料记录
'
' 匹配规则:
'   - 空单元格: 通配符，匹配所有值
'   - 单元格以"!="开头: 否定匹配，提取值不等于该值时匹配
'   - 普通值: 精确匹配
'   - fjgn字段: 包含匹配（InStr判断）
'
' 匹配逻辑: AND逻辑，所有条件列都必须满足
' ==============================================================================
Option Explicit

' 模块级变量 - 错误记录器
Private g_Logger As clsErrorLogger

' BOM库工作表数据缓存（用于性能优化）
Private g_BOMCache As Object
Private g_CacheWorkbookName As String

' ------------------------------------------------------------------------------
' 初始化BOM匹配器
' ------------------------------------------------------------------------------
Public Sub InitBOMMatcher(logger As clsErrorLogger)
    Set g_Logger = logger
    Set g_BOMCache = CreateObject("Scripting.Dictionary")
    g_CacheWorkbookName = ""
End Sub

' ------------------------------------------------------------------------------
' 主入口: 在BOM库中匹配物料记录
'
' 输入:
'   ws - BOM库工作表（如"接头"、"弹性元件"等）
'   params - 从产品型号中提取的参数字典（包含azxs, bkxs, gclj, jycz, lcfw, fjgn等）
'
' 输出:
'   Object (Scripting.Dictionary) - 匹配结果
'   键值对: "success"->Boolean, "rowCount"->Long, "rowNums"->Collection, "message"->String
'
'   - success: 是否恰好匹配到1条记录
'   - rowCount: 匹配到的记录数量
'   - rowNums: 匹配到的行号集合
'   - message: 匹配结果描述（成功/失败原因）
'
' 示例:
'   Set result = MatchBOMRecord(wsJoint, params)
'   ' If result("success") Then
'   '     ' 使用匹配到的记录
'   ' Else
'   '     ' 记录错误到备注
'   ' End If
' ------------------------------------------------------------------------------
Public Function MatchBOMRecord(ByVal ws As Worksheet, ByVal params As Object) As Object
    On Error GoTo ErrorHandler

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

    ' 验证输入
    If ws Is Nothing Then
        result("success") = False
        result("rowCount") = 0
        result("rowNums") = New Collection
        result("message") = "工作表为空"
        Set MatchBOMRecord = result
        Exit Function
    End If

    If params Is Nothing Or params.count = 0 Then
        result("success") = False
        result("rowCount") = 0
        result("rowNums") = New Collection
        result("message") = "参数字典为空"
        Set MatchBOMRecord = result
        Exit Function
    End If

    ' 读取工作表数据到数组（性能优化）
    Dim bomData As Variant
    Dim headerRow As Variant
    Dim lastRow As Long
    Dim lastCol As Long

    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row
    lastCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column

    ' 如果没有数据行
    If lastRow < BOMLIB_START_ROW Then
        result("success") = False
        result("rowCount") = 0
        result("rowNums") = New Collection
        result("message") = "工作表无数据"
        Set MatchBOMRecord = result
        Exit Function
    End If

    ' 读取数据到数组
    bomData = ws.Range(ws.Cells(BOMLIB_START_ROW, 1), ws.Cells(lastRow, lastCol)).Value
    headerRow = ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Value

    ' 构建表头映射（列名 -> 列索引）
    Dim headerMap As Object
    Set headerMap = BuildHeaderMapping(headerRow, lastCol)

    ' 遍历所有行，查找匹配
    Dim matchingRows As Collection
    Set matchingRows = New Collection

    Dim r As Long
    Dim RowIndex As Long

    For r = LBound(bomData, 1) To UBound(bomData, 1)
        RowIndex = BOMLIB_START_ROW + (r - LBound(bomData, 1))

        ' 评估该行是否匹配
        If EvaluateConditionRow(bomData, r, headerMap, params) Then
            matchingRows.Add RowIndex
        End If
    Next r

    ' 构建结果
    result("rowCount") = matchingRows.count
    Set result("rowNums") = matchingRows

    ' 判断匹配结果
    If matchingRows.count = 0 Then
        result("success") = False
        result("message") = "未找到匹配记录"
    ElseIf matchingRows.count = 1 Then
        result("success") = True
        result("message") = "匹配成功"
    Else
        result("success") = False
        result("message") = "匹配到" & matchingRows.count & "条记录（需要恰好1条）"
    End If

    Set MatchBOMRecord = result
    Exit Function

ErrorHandler:
    If Not g_Logger Is Nothing Then
        g_Logger.Record 0, "M07.MatchBOMRecord", "SystemError", _
            "匹配过程发生错误: " & Err.Description, ws.Name
    End If

    result("success") = False
    result("rowCount") = 0
    Set result("rowNums") = New Collection
    result("message") = "系统错误: " & Err.Description
    Set MatchBOMRecord = result
End Function

' ------------------------------------------------------------------------------
' 评估单行数据是否匹配参数
'
' 输入:
'   bomData - BOM库数据数组
'   rowIdx - 数组行索引
'   headerMap - 表头映射（列名 -> 列索引）
'   params - 提取的参数字典
'
' 输出:
'   Boolean - True表示该行匹配，False表示不匹配
'
' 逻辑:
'   - 对于参数字典中的每个键，在工作表中查找对应列
'   - 评估该列的单元格条件是否满足
'   - 所有条件都满足时返回True（AND逻辑）
' ------------------------------------------------------------------------------
Private Function EvaluateConditionRow( _
    ByRef bomData As Variant, _
    ByVal rowIdx As Long, _
    ByVal headerMap As Object, _
    ByVal params As Object _
) As Boolean
    On Error GoTo ErrorHandler

    Dim paramKey As Variant

    ' 遍历所有参数
    For Each paramKey In params.keys
        Dim paramValue As String
        paramValue = CStr(params(paramKey))

        ' 检查BOM库中是否有该列
        If headerMap.Exists(CStr(paramKey)) Then
            Dim colIdx As Long
            colIdx = headerMap(CStr(paramKey))

            ' 获取单元格值
            Dim cellValue As Variant
            cellValue = bomData(rowIdx, colIdx)

            ' 评估单元格条件
            If Not EvaluateCellCondition(cellValue, paramValue, CStr(paramKey)) Then
                ' 只要有一个条件不满足，该行就不匹配
                EvaluateConditionRow = False
                Exit Function
            End If
        End If
    Next paramKey

    ' 所有条件都满足
    EvaluateConditionRow = True
    Exit Function

ErrorHandler:
    EvaluateConditionRow = False
End Function

' ------------------------------------------------------------------------------
' 评估单个单元格条件是否满足
'
' 输入:
'   cellValue - BOM库单元格的值
'   paramValue - 从产品型号中提取的参数值
'   fieldName - 字段名称（用于特殊处理）
'
' 输出:
'   Boolean - True表示条件满足，False表示不满足
'
' 匹配规则:
'   1. 空单元格或IsEmpty: 通配符，匹配所有值（返回True）
'   2. 单元格以"!="开头: 否定匹配，paramValue不等于该值时返回True
'   3. fjgn字段: 包含匹配，paramValue包含cellValue时返回True
'   4. 普通值: 精确匹配，paramValue等于cellValue时返回True
' ------------------------------------------------------------------------------
Public Function EvaluateCellCondition( _
    ByVal cellValue As Variant, _
    ByVal paramValue As String, _
    ByVal fieldName As String _
) As Boolean
    On Error GoTo ErrorHandler

    ' 处理空单元格（通配符）
    If IsEmpty(cellValue) Or Len(Trim(CStr(cellValue))) = 0 Then
        EvaluateCellCondition = True
        Exit Function
    End If

    Dim cellStr As String
    cellStr = Trim(CStr(cellValue))

    ' 处理否定条件 (!=开头）
    If Left(cellStr, 2) = "!=" Then
        Dim notValue As String
        notValue = Trim(Mid(cellStr, 3))
        EvaluateCellCondition = (paramValue <> notValue)
        Exit Function
    End If

    ' 处理fjgn字段（包含匹配）
    If LCase(fieldName) = "fjgn" Then
        EvaluateCellCondition = CheckFjgnMatch(cellStr, paramValue)
        Exit Function
    End If

    ' 支持双值匹配（如 "A0,径向" 可以匹配 "A0" 或 "径向"）
    ' 检查参数值是否包含逗号（表示有映射值）
    If InStr(paramValue, ",") > 0 Then
        Dim paramValues As Variant
        paramValues = Split(paramValue, ",")

        ' 只要参数中的任意一个值匹配单元格值，即认为匹配
        Dim i As Long
        For i = LBound(paramValues) To UBound(paramValues)
            If Trim(CStr(paramValues(i))) = cellStr Then
                EvaluateCellCondition = True
                Exit Function
            End If
        Next i

        ' 所有值都不匹配
        EvaluateCellCondition = False
        Exit Function
    End If

    ' 单值精确匹配
    EvaluateCellCondition = (paramValue = cellStr)
    Exit Function

ErrorHandler:
    EvaluateCellCondition = False
End Function

' ------------------------------------------------------------------------------
' 检查附加功能(fjgn)是否匹配
'
' 输入:
'   cellValue - BOM库中的fjgn值（如: "N1" 或 "N3"）
'   fjgnList - 从产品型号中提取的fjgn列表（如: "N1,N2" 或 "Y3"）
'
' 输出:
'   Boolean - True表示fjgnList中包含cellValue
'
' 逻辑:
'   - 使用InStr判断fjgnList中是否包含cellValue
'   - 支持逗号分隔的多个功能
' ------------------------------------------------------------------------------
Public Function CheckFjgnMatch(ByVal cellValue As String, ByVal fjgnList As String) As Boolean
    On Error GoTo ErrorHandler

    cellValue = Trim(cellValue)
    fjgnList = Trim(fjgnList)

    ' 如果fjgn列表为空，不匹配
    If Len(fjgnList) = 0 Then
        CheckFjgnMatch = False
        Exit Function
    End If

    ' 检查fjgnList中是否包含cellValue
    ' 使用InStr进行包含匹配
    CheckFjgnMatch = (InStr(fjgnList, cellValue) > 0)
    Exit Function

ErrorHandler:
    CheckFjgnMatch = False
End Function

' ------------------------------------------------------------------------------
' 构建表头映射（列名 -> 列索引）
'
' 输入:
'   headerRow - 表头行数据数组（二维）
'   lastCol - 最后一列的索引
'
' 输出:
'   Object (Scripting.Dictionary) - 表头映射字典
'   键: 列名（小写），值: 列索引（从1开始）
'
' 示例:
'   headerRow = Array("azxs", "bkxs", "gclj", "物料名称", "物料编码")
'   返回: {"azxs":1, "bkxs":2, "gclj":3, "物料名称":4, "物料编码":5}
' ------------------------------------------------------------------------------
Private Function BuildHeaderMapping(ByRef headerRow As Variant, ByVal lastCol As Long) As Object
    Dim headerMap As Object
    Set headerMap = CreateObject("Scripting.Dictionary")

    Dim c As Long
    For c = 1 To lastCol
        Dim colName As String
        colName = Trim(CStr(headerRow(1, c)))

        If Len(colName) > 0 Then
            ' 使用小写作为键，避免大小写问题
            Dim colKey As String
            colKey = LCase(colName)

            If Not headerMap.Exists(colKey) Then
                headerMap.Add colKey, c
            End If
        End If
    Next c

    Set BuildHeaderMapping = headerMap
End Function

' ------------------------------------------------------------------------------
' 从匹配行中提取物料信息
'
' 输入:
'   ws - BOM库工作表
'   rowNum - 匹配到的行号
'   headerMap - 表头映射
'
' 输出:
'   Object (Scripting.Dictionary) - 物料信息
'   键值对: "materialName"->物料名称, "materialCode"->物料编码,
'          "materialQty"->物料数量, "materialType"->物料类型（工作表名）
'
' 逻辑:
'   - 通过列名查找物料信息列（不依赖列位置）
'   - 支持"名称"、"编码"、"数量"列
' ------------------------------------------------------------------------------
Public Function ExtractMaterialInfo( _
    ByVal ws As Worksheet, _
    ByVal rowNum As Long, _
    ByVal headerMap As Object _
) As Object
    On Error GoTo ErrorHandler

    Dim materialInfo As Object
    Set materialInfo = CreateObject("Scripting.Dictionary")
    materialInfo("materialType") = ws.Name

    ' 通过列名查找物料信息列
    Dim nameKey As String, codeKey As String, qtyKey As String
    nameKey = LCase(BOMLIB_COL_NAME)
    codeKey = LCase(BOMLIB_COL_CODE)
    qtyKey = LCase(BOMLIB_COL_QTY)

    ' 提取物料名称
    If headerMap.Exists(nameKey) Then
        Dim nameCol As Long
        nameCol = headerMap(nameKey)
        materialInfo("materialName") = Trim(CStr(ws.Cells(rowNum, nameCol).Value))
    Else
        materialInfo("materialName") = ""
    End If

    ' 提取物料编码
    If headerMap.Exists(codeKey) Then
        Dim codeCol As Long
        codeCol = headerMap(codeKey)
        materialInfo("materialCode") = Trim(CStr(ws.Cells(rowNum, codeCol).Value))
    Else
        materialInfo("materialCode") = ""
    End If

    ' 提取物料数量
    If headerMap.Exists(qtyKey) Then
        Dim qtyCol As Long
        qtyCol = headerMap(qtyKey)
        Dim qtyValue As Variant
        qtyValue = ws.Cells(rowNum, qtyCol).Value
        If IsNumeric(qtyValue) Then
            materialInfo("materialQty") = CLng(qtyValue)
        Else
            materialInfo("materialQty") = 1
        End If
    Else
        materialInfo("materialQty") = 1
    End If

    Set ExtractMaterialInfo = materialInfo
    Exit Function

ErrorHandler:
    If Not g_Logger Is Nothing Then
        g_Logger.Record rowNum, "M07.ExtractMaterialInfo", "SystemError", _
            "提取物料信息失败: " & Err.Description, ws.Name
    End If
    Set ExtractMaterialInfo = CreateObject("Scripting.Dictionary")
End Function

' ------------------------------------------------------------------------------
' 构建工作表的表头映射
'
' 输入:
'   ws - BOM库工作表
'
' 输出:
'   Object (Scripting.Dictionary) - 表头映射字典
'
' 说明:
'   - 公开函数，用于外部构建表头映射
' ------------------------------------------------------------------------------
Public Function BuildWorksheetHeaderMap(ByVal ws As Worksheet) As Object
    If ws Is Nothing Then
        Set BuildWorksheetHeaderMap = CreateObject("Scripting.Dictionary")
        Exit Function
    End If

    Dim lastCol As Long
    lastCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column

    Dim headerRow As Variant
    headerRow = ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Value

    Set BuildWorksheetHeaderMap = BuildHeaderMapping(headerRow, lastCol)
End Function