' ============================================================================== ' 模块: 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 ' 精确匹配 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