admin/AutoBOM
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: improve BOM library matching logic with column-name-based lookup
All checks were successful
NTFY Notification / notify (push) Successful in 3s
Details

Browse Source 
- 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>
This commit is contained in:
Misaka_Company
2026-02-12 13:59:48 +08:00
parent c204a8878e
commit 867b1979af
4 changed files with 181 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
VBA_BOMConverter/Modules/M04_Config.bas
View File

@@ -54,6 +54,45 @@ Public Const BOMLIB_SHEET_MOVEMENT As String = "机芯"
Public Const BOMLIB_SHEET_COMPONENT As String = "部件"
Public Const BOMLIB_SHEET_EDGE As String = "边"
' BOM库物料列名常量
Public Const BOMLIB_COL_NAME As String = "名称"
Public Const BOMLIB_COL_CODE As String = "编码"
Public Const BOMLIB_COL_QTY As String = "数量"
Public Const BOMLIB_COL_JOINT_NAME As String = "接头名称"
Public Const BOMLIB_COL_JOINT_CODE As String = "接头编码"
Public Const BOMLIB_COL_JOINT_QTY As String = "接头数量"
Public Const BOMLIB_COL_ELEMENT_NAME As String = "弹性元件名称"
Public Const BOMLIB_COL_ELEMENT_CODE As String = "弹性元件编码"
Public Const BOMLIB_COL_ELEMENT_QTY As String = "弹性元件数量"
' BOM库条件字段列表（所有可能的条件字段）
Public Function GetBOMConditionFields() As Variant
GetBOMConditionFields = Array( _
"azxs", "bkxs", "gclj", "jycz", "lcdw", "lcfw", _
"fjgn", "btcy", "bp", "dskd", "nqlc", "bptx", _
"jddj", "cpdm", "tsjz", "tsyq", "bpts", "kdxh" _
)
End Function
' 检查列名是否为条件列
Public Function IsConditionField(ByVal colName As String) As Boolean
Dim fields As Variant
fields = GetBOMConditionFields()
Dim i As Long
Dim lowerColName As String
lowerColName = LCase(Trim(colName))
For i = LBound(fields) To UBound(fields)
If lowerColName = LCase(fields(i)) Then
IsConditionField = True
Exit Function
End If
Next i
IsConditionField = False
End Function
' 获取表头排序索引 (越小越靠前)
Public Function GetHeaderPriority(key As String) As Long
Dim vList As Variant

38
VBA_BOMConverter/Modules/M07_BOMMatcher.bas
View File

@@ -351,9 +351,9 @@ End Function
' 键值对: "materialName"->物料名称, "materialCode"->物料编码,
' "materialQty"->物料数量, "materialType"->物料类型（工作表名）
'
' 注意:
' - 默认查找"物料名称"、"物料编码"、"物料数量"列
' - 如果列名不同，可以根据实际情况调整
' 逻辑:
' - 通过列名查找物料信息列（不依赖列位置）
' - 支持"名称"、"编码"、"数量"列
' ------------------------------------------------------------------------------
Public Function ExtractMaterialInfo( _
ByVal ws As Worksheet, _
@@ -364,28 +364,38 @@ Public Function ExtractMaterialInfo( _
Dim materialInfo As Object
Set materialInfo = CreateObject("Scripting.Dictionary")
' 默认物料信息列名
materialInfo("materialType") = ws.Name
' 查找物料名称列
If headerMap.Exists("物料名称") Then
materialInfo("materialName") = Trim(CStr(ws.Cells(rowNum, headerMap("物料名称")).Value))
' 通过列名查找物料信息列
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("物料编码") Then
materialInfo("materialCode") = Trim(CStr(ws.Cells(rowNum, headerMap("物料编码")).Value))
' 提取物料编码
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("物料数量") Then
' 提取物料数量
If headerMap.Exists(qtyKey) Then
Dim qtyCol As Long
qtyCol = headerMap(qtyKey)
Dim qtyValue As Variant
qtyValue = ws.Cells(rowNum, headerMap("物料数量")).Value
qtyValue = ws.Cells(rowNum, qtyCol).Value
If IsNumeric(qtyValue) Then
materialInfo("materialQty") = CLng(qtyValue)
Else

85
VBA_BOMConverter/Modules/M08_ComponentProcessor.bas
View File

@@ -195,27 +195,38 @@ Private Function ExtractComponentInfo( _
Dim componentInfo As Object
Set componentInfo = CreateObject("Scripting.Dictionary")
componentInfo("materialType") = componentType
' 通过列名常量查找物料信息列
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("物料名称") Then
componentInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, headerMap("物料名称")).Value))
If headerMap.Exists(nameKey) Then
Dim nameCol As Long
nameCol = headerMap(nameKey)
componentInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, nameCol).Value))
Else
componentInfo("materialName") = ""
End If
' 查找物料编码列
If headerMap.Exists("物料编码") Then
componentInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, headerMap("物料编码")).Value))
If headerMap.Exists(codeKey) Then
Dim codeCol As Long
codeCol = headerMap(codeKey)
componentInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, codeCol).Value))
Else
componentInfo("materialCode") = ""
End If
' 查找物料数量列
If headerMap.Exists("物料数量") Then
If headerMap.Exists(qtyKey) Then
Dim qtyCol As Long
qtyCol = headerMap(qtyKey)
Dim qtyValue As Variant
qtyValue = wsComponent.Cells(rowNum, headerMap("物料数量")).Value
qtyValue = wsComponent.Cells(rowNum, qtyCol).Value
If IsNumeric(qtyValue) Then
componentInfo("materialQty") = CLng(qtyValue)
Else
@@ -304,9 +315,10 @@ End Function
' 输出:
' Object (Scripting.Dictionary) - 子件物料信息
'
' 注意:
' - 列名格式: "接头_物料名称"、"接头_物料编码"、"接头_物料数量"
' - 或者: "子件1_物料名称"、"子件1_物料编码"等
' 逻辑:
' - 通过列名查找子部件信息（不依赖列位置）
' - 接头: 查找"接头名称"、"接头编码"、"接头数量"
' - 弹性元件: 查找"弹性元件名称"、"弹性元件编码"、"弹性元件数量"
' ------------------------------------------------------------------------------
Private Function ExtractSingleSubComponent( _
ByVal wsComponent As Worksheet, _
@@ -318,36 +330,53 @@ Private Function ExtractSingleSubComponent( _
Dim subInfo As Object
Set subInfo = CreateObject("Scripting.Dictionary")
subInfo("materialType") = subComponentType
' 查找子件物料名称列
Dim nameColKey As String
nameColKey = LCase(subComponentType & "_物料名称")
' 根据子件类型确定列名
Dim nameKey As String, codeKey As String, qtyKey As String
If headerMap.Exists(nameColKey) Then
subInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, headerMap(nameColKey)).Value))
If subComponentType = "接头" Then
nameKey = LCase(BOMLIB_COL_JOINT_NAME)
codeKey = LCase(BOMLIB_COL_JOINT_CODE)
qtyKey = LCase(BOMLIB_COL_JOINT_QTY)
ElseIf subComponentType = "弹性元件" Then
nameKey = LCase(BOMLIB_COL_ELEMENT_NAME)
codeKey = LCase(BOMLIB_COL_ELEMENT_CODE)
qtyKey = LCase(BOMLIB_COL_ELEMENT_QTY)
Else
' 未知类型，返回空信息
subInfo("materialName") = ""
subInfo("materialCode") = ""
subInfo("materialQty") = 0
subInfo("remarks") = "未知子件类型: " & subComponentType
Set ExtractSingleSubComponent = subInfo
Exit Function
End If
' 提取物料名称
If headerMap.Exists(nameKey) Then
Dim nameCol As Long
nameCol = headerMap(nameKey)
subInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, nameCol).Value))
Else
subInfo("materialName") = ""
End If
' 查找子件物料编码列
Dim codeColKey As String
codeColKey = LCase(subComponentType & "_物料编码")
If headerMap.Exists(codeColKey) Then
subInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, headerMap(codeColKey)).Value))
' 提取物料编码
If headerMap.Exists(codeKey) Then
Dim codeCol As Long
codeCol = headerMap(codeKey)
subInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, codeCol).Value))
Else
subInfo("materialCode") = ""
End If
' 查找子件物料数量列
Dim qtyColKey As String
qtyColKey = LCase(subComponentType & "_物料数量")
If headerMap.Exists(qtyColKey) Then
' 提取物料数量
If headerMap.Exists(qtyKey) Then
Dim qtyCol As Long
qtyCol = headerMap(qtyKey)
Dim qtyValue As Variant
qtyValue = wsComponent.Cells(rowNum, headerMap(qtyColKey)).Value
qtyValue = wsComponent.Cells(rowNum, qtyCol).Value
If IsNumeric(qtyValue) Then
subInfo("materialQty") = CLng(qtyValue)
Else

123
VBA_BOMConverter/Modules/M09_BOMExtractor.bas
View File

@@ -375,12 +375,11 @@ End Function
' 输出:
' Collection - 所有匹配到的物料集合
'
' 遍历的工作表:
' - 接头
' - 弹性元件
' - 机芯
' - 部件（特殊处理）
' - 边
' 逻辑:
' - 遍历BOM库中的所有工作表
' - 对每个工作表尝试匹配
' - "部件"工作表特殊处理（调用M08_ComponentProcessor）
' - 其他工作表使用M07_BOMMatcher匹配
' ------------------------------------------------------------------------------
Private Function MatchAllMaterialTypes( _
ByVal params As Object, _
@@ -392,70 +391,70 @@ Private Function MatchAllMaterialTypes( _
Dim allMaterials As Collection
Set allMaterials = New Collection
' 需要遍历的工作表列表
Dim sheetNames As Variant
sheetNames = Array(BOMLIB_SHEET_JOINT, BOMLIB_SHEET_ELEMENT, _
BOMLIB_SHEET_MOVEMENT, BOMLIB_SHEET_EDGE)
Dim i As Long
For i = LBound(sheetNames) To UBound(sheetNames)
' 遍历BOM库中的所有工作表
Dim ws As Worksheet
For Each ws In bomWb.Worksheets
Dim sheetName As String
sheetName = sheetNames(i)
sheetName = ws.Name
' 获取工作表
Dim ws As Worksheet
On Error Resume Next
Set ws = bomWb.Sheets(sheetName)
On Error GoTo ErrorHandler
Debug.Print "=== 处理工作表: [" & sheetName & "] ==="
If ws Is Nothing Then
' 工作表不存在，跳过
GoTo NextSheet
End If
' "部件"工作表特殊处理
If sheetName = BOMLIB_SHEET_COMPONENT Then
Debug.Print " -> 使用部件处理逻辑"
' 匹配记录
Dim matchResult As Object
Set matchResult = M07_BOMMatcher.MatchBOMRecord(ws, params)
Dim componentMaterials As Collection
Set componentMaterials = M08_ComponentProcessor.ProcessComponentRecord( _
ws, params, logger)
' 如果匹配成功，提取物料信息
If matchResult("success") Then
Dim rowNum As Long
rowNum = matchResult("rowNums")(1)
Debug.Print " -> 返回物料数: " & componentMaterials.count
Dim headerMap As Object
Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(ws)
Dim materialInfo As Object
Set materialInfo = M07_BOMMatcher.ExtractMaterialInfo(ws, rowNum, headerMap)
If Not materialInfo Is Nothing Then
allMaterials.Add materialInfo
End If
Dim compMat As Variant
For Each compMat In componentMaterials
Debug.Print " [" & compMat("materialType") & "] 名称=[" & compMat("materialName") & "] 编码=[" & compMat("materialCode") & "]"
allMaterials.Add compMat
Next compMat
Else
' 匹配失败，记录错误（但不中断处理）
logger.Record 0, "M09.MatchAllMaterialTypes", "BOMMatchError", _
sheetName & " " & matchResult("message"), ""
' 其他工作表使用标准匹配逻辑
' 匹配记录
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
NextSheet:
Next i
' 特殊处理"部件"工作表
Dim wsComponent As Worksheet
On Error Resume Next
Set wsComponent = bomWb.Sheets(BOMLIB_SHEET_COMPONENT)
On Error GoTo ErrorHandler
If Not wsComponent Is Nothing Then
Dim componentMaterials As Collection
Set componentMaterials = M08_ComponentProcessor.ProcessComponentRecord( _
wsComponent, params, logger)
Dim compMat As Variant
For Each compMat In componentMaterials
allMaterials.Add compMat
Next compMat
End If
Debug.Print ""
Next ws
Set MatchAllMaterialTypes = allMaterials
Exit Function