diff --git a/VBA_BOMConverter/Modules/M04_Config.bas b/VBA_BOMConverter/Modules/M04_Config.bas index c27a661..1963af0 100644 --- a/VBA_BOMConverter/Modules/M04_Config.bas +++ b/VBA_BOMConverter/Modules/M04_Config.bas @@ -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 diff --git a/VBA_BOMConverter/Modules/M07_BOMMatcher.bas b/VBA_BOMConverter/Modules/M07_BOMMatcher.bas index eebb799..76189cf 100644 --- a/VBA_BOMConverter/Modules/M07_BOMMatcher.bas +++ b/VBA_BOMConverter/Modules/M07_BOMMatcher.bas @@ -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 diff --git a/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas b/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas index 31664f8..fdf8035 100644 --- a/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas +++ b/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas @@ -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 diff --git a/VBA_BOMConverter/Modules/M09_BOMExtractor.bas b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas index c185d60..428789c 100644 --- a/VBA_BOMConverter/Modules/M09_BOMExtractor.bas +++ b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas @@ -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