All checks were successful
NTFY Notification / notify (push) Successful in 3s
- Add BOM library column name constants (名称, 编码, 数量, etc.) - Add GetBOMConditionFields() and IsConditionField() utility functions - Refactor ExtractMaterialInfo to use column names instead of hardcoded positions - Refactor ExtractSingleSubComponent to use column names for 接头/弹性元件 - Refactor ExtractComponentInfo to use column names - Improve MatchAllMaterialTypes to iterate all worksheets dynamically - Add debug logging for troubleshooting This fix resolves issues where worksheets with non-standard column counts (like 表壳, 罩壳) could not extract material information properly. Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
444 lines
14 KiB
QBasic
444 lines
14 KiB
QBasic
' ==============================================================================
|
||
' 模块: 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 |