' ============================================================================== ' 模块: M08_ComponentProcessor ' 职责: 处理"部件"物料的特殊逻辑 ' ' 部件物料特性: ' - 每条"部件"记录包含三个物料的数据: ' 1. 部件物料本身 ' 2. 接头物料(子件1) ' 3. 弹性元件物料(子件2) ' ' 选择策略: ' - 优先选择"部件"物料 ' - 当"部件"物料库存不足时,选择"接头"+"弹性元件" ' - 库存检查接口预留,当前默认返回True(库存充足) ' ' 验证规则: ' - 正常组合1: 1个部件 ' - 正常组合2: 1个接头 + 1个弹性元件 ' - 异常: 其他组合(如只有接头、只有弹性元件、同时有部件和接头等) ' ============================================================================== Option Explicit ' 模块级变量 - 错误记录器 Private g_Logger As clsErrorLogger ' 模块级变量 - 库存追踪 Private g_InventoryDict As Object ' 部件编码 -> 现存量 Private g_AccumulatedDemandDict As Object ' 部件编码 -> 累计需求量 ' ------------------------------------------------------------------------------ ' 初始化部件处理器 ' ------------------------------------------------------------------------------ Public Sub InitComponentProcessor(logger As clsErrorLogger) Set g_Logger = logger End Sub ' ------------------------------------------------------------------------------ ' 初始化部件处理器(带库存校验) ' ' 输入: ' logger - 错误记录器 ' inventoryWb - 包含现存量工作表的工作簿(通常是ThisWorkbook) ' ------------------------------------------------------------------------------ Public Sub InitComponentProcessorWithInventory( _ logger As clsErrorLogger, _ inventoryWb As Workbook _ ) Set g_Logger = logger Call LoadInventoryData(inventoryWb) Set g_AccumulatedDemandDict = CreateObject("Scripting.Dictionary") End Sub ' ------------------------------------------------------------------------------ ' 加载库存数据 ' ' 输入: ' inventoryWb - 包含现存量工作表的工作簿 ' ' 逻辑: ' 1. 查找[现存量]工作表 ' 2. 如果未找到,记录警告并使用空字典(所有库存视为0) ' 3. 从第4行开始读取数据(表头在第3行) ' 4. B列 = 物料编码,J列 = 库存数量 ' 5. 存储到 g_InventoryDict 中 ' ------------------------------------------------------------------------------ Private Sub LoadInventoryData(ByVal inventoryWb As Workbook) On Error GoTo ErrorHandler Set g_InventoryDict = CreateObject("Scripting.Dictionary") ' 检查现存量工作表是否存在 Dim wsInventory As Worksheet On Error Resume Next Set wsInventory = inventoryWb.Sheets(INVENTORY_SHEET_NAME) On Error GoTo ErrorHandler If wsInventory Is Nothing Then ' 未找到现存量工作表,记录警告并使用空字典(所有库存视为0) If Not g_Logger Is Nothing Then g_Logger.RecordWarning "", "M08.LoadInventoryData", "InventorySheetMissing", _ "未找到[" & INVENTORY_SHEET_NAME & "]工作表,所有部件库存将视为0", "" End If Exit Sub End If ' 查找最后一行 Dim lastRow As Long lastRow = wsInventory.Cells(wsInventory.Rows.count, 2).End(xlUp).row ' B列 If lastRow < INVENTORY_HEADER_ROW + 1 Then Exit Sub ' 没有数据 End If ' 从第4行开始读取数据(表头在第3行) Dim i As Long For i = INVENTORY_HEADER_ROW + 1 To lastRow Dim materialCode As String Dim stockQty As Variant materialCode = Trim(CStr(wsInventory.Cells(i, INVENTORY_COL_CODE).Value)) stockQty = wsInventory.Cells(i, INVENTORY_COL_QTY).Value If Len(materialCode) > 0 And IsNumeric(stockQty) Then g_InventoryDict(materialCode) = CLng(stockQty) End If Next i Exit Sub ErrorHandler: If Not g_Logger Is Nothing Then g_Logger.RecordWarning "", "M08.LoadInventoryData", "LoadError", _ "加载库存数据失败: " & err.Description, "" End If End Sub ' ------------------------------------------------------------------------------ ' 主入口: 处理"部件"记录,返回物料集合 ' ' 输入: ' wsComponent - "部件"工作表 ' params - 从产品型号中提取的参数字典 ' logger - 错误记录器 ' matchedRowNum - 匹配到的行号(由调用者传入,避免重复匹配) ' ' 输出: ' Collection - 物料集合 ' 每个元素是一个字典,包含: materialName, materialCode, materialQty, materialType, remarks ' ' 逻辑流程: ' 1. 使用传入的matchedRowNum定位匹配记录 ' 2. 检查"部件"物料库存 ' 3. 如果有库存,返回部件物料 ' 4. 如果无库存,提取子件(接头+弹性元件) ' ' 示例: ' Set materials = ProcessComponentRecord(wsComponent, params, logger, 5) ' ' materials(1) - 部件物料 或 接头物料 ' ' materials(2) - 弹性元件物料(如果选择子件) ' ------------------------------------------------------------------------------ Public Function ProcessComponentRecord( _ ByVal wsComponent As Worksheet, _ ByVal params As Object, _ ByVal logger As clsErrorLogger, _ ByVal matchedRowNum As Long, _ ByVal orderQty As Long, _ ByVal productionOrderNo As String _ ) As Collection On Error GoTo ErrorHandler Dim materials As Collection Set materials = New Collection ' 步骤1: 验证传入的行号 If matchedRowNum <= 0 Then ' 无效行号,返回错误物料 Dim errorMaterial As Object Set errorMaterial = CreateObject("Scripting.Dictionary") errorMaterial("materialType") = "部件" errorMaterial("materialName") = "" errorMaterial("materialCode") = "" errorMaterial("materialQty") = 0 errorMaterial("remarks") = "无效的匹配行号" materials.Add errorMaterial Set ProcessComponentRecord = materials Exit Function End If ' 步骤2: 使用传入的行号 ' 步骤3: 构建表头映射 Dim headerMap As Object Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(wsComponent) ' 步骤4: 检查部件库存 Dim componentInfo As Object If CheckComponentInventory(wsComponent, matchedRowNum, headerMap, orderQty, productionOrderNo) Then ' 库存充足,返回部件物料 Set componentInfo = ExtractComponentInfo(wsComponent, matchedRowNum, headerMap, "部件") componentInfo("remarks") = "" componentInfo("isStockSufficient") = True If Not componentInfo Is Nothing Then materials.Add componentInfo End If Else ' 【关键修复】库存不足时,同时返回部件(标记)和子件 ' 步骤1: 返回部件信息(用于库存比对表) Set componentInfo = ExtractComponentInfo(wsComponent, matchedRowNum, headerMap, "部件") componentInfo("remarks") = "部件无库存,使用子件" componentInfo("isStockSufficient") = False If Not componentInfo Is Nothing Then materials.Add componentInfo End If ' 步骤2: 返回子件信息(用于BOM提取结果和BIP上传) Dim subComponents As Collection Set subComponents = ExtractSubComponents(wsComponent, matchedRowNum, headerMap) Dim subComp As Variant For Each subComp In subComponents materials.Add subComp Next subComp End If Set ProcessComponentRecord = materials Exit Function ErrorHandler: If Not logger Is Nothing Then logger.Record productionOrderNo, "M08.ProcessComponentRecord", "SystemError", _ "处理部件记录失败: " & err.Description, "" End If ' 返回错误物料 Dim errorMat As Object Set errorMat = CreateObject("Scripting.Dictionary") errorMat("materialType") = "部件" errorMat("materialName") = "" errorMat("materialCode") = "" errorMat("materialQty") = 0 errorMat("remarks") = "系统错误: " & err.Description Dim errorCol As New Collection errorCol.Add errorMat Set ProcessComponentRecord = errorCol End Function ' ------------------------------------------------------------------------------ ' 检查部件库存状态(集成库存校验) ' ' 输入: ' wsComponent - "部件"工作表 ' rowNum - 匹配到的行号 ' headerMap - 表头映射 ' orderQty - 订单数量 ' ' 输出: ' Boolean - True表示库存充足,False表示库存不足 ' ' 逻辑: ' 1. 提取部件编码 ' 2. 获取BOM需求量(部件工作表中的数量列) ' 3. 检查库存数据是否存在 ' 4. 计算累计需求量 = 订单数量 × BOM需求量 + 之前累计需求 ' 5. 比较库存和需求,更新累计需求量 ' ' 示例: ' 订单1、订单3、订单6都用部件A,每个订单数量=2,BOM需求量=1,现存量=5 ' - 订单1:累计需求 = 2×1 + 0 = 2,5 >= 2 ?? true(使用部件) ' - 订单3:累计需求 = 2×1 + 2 = 4,5 >= 4 ?? true(使用部件) ' - 订单6:累计需求 = 2×1 + 4 = 6,5 < 6 ?? false(使用子件) ' ------------------------------------------------------------------------------ Private Function CheckComponentInventory( _ ByVal wsComponent As Worksheet, _ ByVal rowNum As Long, _ ByVal headerMap As Object, _ ByVal orderQty As Long, _ ByVal productionOrderNo As String _ ) As Boolean On Error GoTo ErrorHandler ' 步骤1: 提取部件编码 Dim codeCol As Long Dim codeKey As String codeKey = LCase(BOMLIB_COL_CODE) If Not headerMap.Exists(codeKey) Then ' 没有编码列,默认返回True(库存充足) CheckComponentInventory = True Exit Function End If codeCol = headerMap(codeKey) Dim componentCode As String componentCode = Trim(CStr(wsComponent.Cells(rowNum, codeCol).Value)) If Len(componentCode) = 0 Then ' 没有编码,默认返回True CheckComponentInventory = True Exit Function End If ' 步骤2: 获取BOM需求量(部件工作表中的数量列) Dim bomQty As Long bomQty = 1 ' 默认为1 Dim qtyKey As String qtyKey = LCase(BOMLIB_COL_QTY) If headerMap.Exists(qtyKey) Then Dim qtyCol As Long Dim qtyValue As Variant qtyCol = headerMap(qtyKey) qtyValue = wsComponent.Cells(rowNum, qtyCol).Value If IsNumeric(qtyValue) Then bomQty = CLng(qtyValue) End If End If ' 步骤3: 检查库存数据是否存在 If g_InventoryDict Is Nothing Or Not g_InventoryDict.Exists(componentCode) Then ' 未找到库存数据,记录警告并返回False(库存不足) If Not g_Logger Is Nothing Then g_Logger.RecordWarning productionOrderNo, "M08.CheckComponentInventory", "InventoryNotFound", _ "部件[" & componentCode & "]未找到库存数据,视为库存不足", "" End If CheckComponentInventory = False Exit Function End If ' 步骤4: 计算累计需求量 Dim currentDemand As Long currentDemand = orderQty * bomQty Dim accumulatedDemand As Long If g_AccumulatedDemandDict.Exists(componentCode) Then accumulatedDemand = g_AccumulatedDemandDict(componentCode) End If Dim totalDemand As Long totalDemand = accumulatedDemand + currentDemand ' 步骤5: 比较库存和需求 Dim stockQty As Long stockQty = g_InventoryDict(componentCode) If stockQty >= totalDemand Then ' 库存充足,更新累计需求量 g_AccumulatedDemandDict(componentCode) = totalDemand CheckComponentInventory = True Else ' 库存不足,记录警告(不是错误) If Not g_Logger Is Nothing Then g_Logger.RecordWarning productionOrderNo, "M08.CheckComponentInventory", "InsufficientInventory", _ "部件[" & componentCode & "]库存不足。库存=" & stockQty & ", 累计需求=" & totalDemand, "" End If CheckComponentInventory = False End If Exit Function ErrorHandler: If Not g_Logger Is Nothing Then g_Logger.Record productionOrderNo, "M08.CheckComponentInventory", "SystemError", _ "库存检查失败: " & err.Description, "" End If ' 出错时返回False(库存不足) CheckComponentInventory = False End Function ' ------------------------------------------------------------------------------ ' 提取部件物料信息 ' ' 输入: ' wsComponent - "部件"工作表 ' rowNum - 匹配到的行号 ' headerMap - 表头映射 ' componentType - 部件类型("部件") ' ' 输出: ' Object (Scripting.Dictionary) - 部件物料信息 ' 键值对: materialName, materialCode, materialQty, materialType, remarks ' ------------------------------------------------------------------------------ Private Function ExtractComponentInfo( _ ByVal wsComponent As Worksheet, _ ByVal rowNum As Long, _ ByVal headerMap As Object, _ ByVal componentType As String _ ) As Object On Error GoTo ErrorHandler 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(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(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(qtyKey) Then Dim qtyCol As Long qtyCol = headerMap(qtyKey) Dim qtyValue As Variant qtyValue = wsComponent.Cells(rowNum, qtyCol).Value If IsNumeric(qtyValue) Then componentInfo("materialQty") = CLng(qtyValue) Else componentInfo("materialQty") = 1 End If Else componentInfo("materialQty") = 1 End If componentInfo("remarks") = "" componentInfo("isStockSufficient") = True ' 默认值,会在 ProcessComponentRecord 中被覆盖 Set ExtractComponentInfo = componentInfo Exit Function ErrorHandler: If Not g_Logger Is Nothing Then g_Logger.Record "", "M08.ExtractComponentInfo", "SystemError", _ "提取部件信息失败: " & err.Description, componentType End If Set ExtractComponentInfo = Nothing End Function ' ------------------------------------------------------------------------------ ' 提取子部件信息(接头+弹性元件) ' ' 输入: ' wsComponent - "部件"工作表 ' rowNum - 匹配到的行号 ' headerMap - 表头映射 ' ' 输出: ' Collection - 子部件集合 ' 包含2个元素: 接头物料、弹性元件物料 ' ' 注意: ' - "部件"工作表中,子件信息存储在特定列中 ' - 需要根据实际的BOM库结构调整列名 ' - 默认查找"接头_物料名称"、"接头_物料编码"、"接头_物料数量"等列 ' ------------------------------------------------------------------------------ Private Function ExtractSubComponents( _ ByVal wsComponent As Worksheet, _ ByVal rowNum As Long, _ ByVal headerMap As Object _ ) As Collection On Error GoTo ErrorHandler Dim subComponents As Collection Set subComponents = New Collection ' 提取接头信息 Dim jointInfo As Object Set jointInfo = ExtractSingleSubComponent(wsComponent, rowNum, headerMap, "接头") If Not jointInfo Is Nothing Then subComponents.Add jointInfo End If ' 提取弹性元件信息 Dim elementInfo As Object Set elementInfo = ExtractSingleSubComponent(wsComponent, rowNum, headerMap, "弹性元件") If Not elementInfo Is Nothing Then subComponents.Add elementInfo End If Set ExtractSubComponents = subComponents Exit Function ErrorHandler: If Not g_Logger Is Nothing Then g_Logger.Record "", "M08.ExtractSubComponents", "SystemError", _ "提取子件信息失败: " & err.Description, "" End If Set ExtractSubComponents = New Collection End Function ' ------------------------------------------------------------------------------ ' 提取单个子部件信息 ' ' 输入: ' wsComponent - "部件"工作表 ' rowNum - 匹配到的行号 ' headerMap - 表头映射 ' subComponentType - 子件类型("接头" 或 "弹性元件") ' ' 输出: ' Object (Scripting.Dictionary) - 子件物料信息 ' ' 逻辑: ' - 通过列名查找子部件信息(不依赖列位置) ' - 接头: 查找"接头名称"、"接头编码"、"接头数量" ' - 弹性元件: 查找"弹性元件名称"、"弹性元件编码"、"弹性元件数量" ' ------------------------------------------------------------------------------ Private Function ExtractSingleSubComponent( _ ByVal wsComponent As Worksheet, _ ByVal rowNum As Long, _ ByVal headerMap As Object, _ ByVal subComponentType As String _ ) As Object On Error GoTo ErrorHandler Dim subInfo As Object Set subInfo = CreateObject("Scripting.Dictionary") subInfo("materialType") = subComponentType ' 根据子件类型确定列名 Dim nameKey As String, codeKey As String, qtyKey As String 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 ' 提取物料编码 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 ' 提取物料数量 If headerMap.Exists(qtyKey) Then Dim qtyCol As Long qtyCol = headerMap(qtyKey) Dim qtyValue As Variant qtyValue = wsComponent.Cells(rowNum, qtyCol).Value If IsNumeric(qtyValue) Then subInfo("materialQty") = CLng(qtyValue) Else subInfo("materialQty") = 1 End If Else subInfo("materialQty") = 1 End If subInfo("remarks") = "部件无库存,使用子件" Set ExtractSingleSubComponent = subInfo Exit Function ErrorHandler: If Not g_Logger Is Nothing Then g_Logger.Record "", "M08.ExtractSingleSubComponent", "SystemError", _ "提取子件[" & subComponentType & "]失败: " & err.Description, "" End If Set ExtractSingleSubComponent = Nothing End Function ' ------------------------------------------------------------------------------ ' 获取部件库存信息(用于库存比对工作表) ' ' 输入: ' componentCode - 部件编码 ' bomQty - BOM需求量(单个产品) ' orderQty - 订单数量 ' ' 输出: ' Object - 库存信息字典 ' .stockQty - 库存数量 ' .requiredQty - 所需数量 (orderQty × bomQty) ' .accumulatedDemand - 累计需求量 ' .totalDemand - 总需求量 (累计需求 + 当前需求) ' .isSufficient - 库存是否充足 (True/False) ' ' 注意: ' - 此函数是只读的,不会修改 g_AccumulatedDemandDict ' - 库存充足性判断基于累计需求量,但仅返回结果,不更新状态 ' ------------------------------------------------------------------------------ Public Function GetComponentInventoryInfo( _ ByVal componentCode As String, _ ByVal bomQty As Long, _ ByVal orderQty As Long _ ) As Object On Error GoTo ErrorHandler Dim invInfo As Object Set invInfo = CreateObject("Scripting.Dictionary") ' 步骤1: 获取库存数量 Dim stockQty As Long stockQty = 0 ' 默认值为0 If Not g_InventoryDict Is Nothing And g_InventoryDict.Exists(componentCode) Then stockQty = g_InventoryDict(componentCode) End If ' 步骤2: 计算需求量 Dim requiredQty As Long requiredQty = orderQty * bomQty Dim accumulatedDemand As Long accumulatedDemand = 0 If Not g_AccumulatedDemandDict Is Nothing Then If g_AccumulatedDemandDict.Exists(componentCode) Then accumulatedDemand = g_AccumulatedDemandDict(componentCode) End If End If Dim totalDemand As Long totalDemand = accumulatedDemand + requiredQty ' 步骤3: 判断库存是否充足 Dim isSufficient As Boolean isSufficient = (stockQty >= totalDemand) ' 步骤4: 返回库存信息 invInfo("stockQty") = stockQty invInfo("requiredQty") = requiredQty invInfo("accumulatedDemand") = accumulatedDemand invInfo("totalDemand") = totalDemand invInfo("isSufficient") = isSufficient Set GetComponentInventoryInfo = invInfo Exit Function ErrorHandler: ' 出错时返回默认值(库存不足) Dim errorInfo As Object Set errorInfo = CreateObject("Scripting.Dictionary") errorInfo("stockQty") = 0 errorInfo("requiredQty") = orderQty * bomQty errorInfo("accumulatedDemand") = 0 errorInfo("totalDemand") = orderQty * bomQty errorInfo("isSufficient") = False Set GetComponentInventoryInfo = errorInfo End Function ' ------------------------------------------------------------------------------ ' 验证部件组合是否有效 ' ' 输入: ' materials - 物料集合(包含所有类型的物料) ' ' 输出: ' Object (Scripting.Dictionary) - 验证结果 ' 键值对: "valid"->Boolean, "message"->String ' ' 验证规则: ' - 正确组合1: 1个部件 ' - 正确组合2: 1个接头 + 1个弹性元件 ' - 异常: 其他组合 ' ' 示例: ' Set validation = ValidateComponentCombination(materials) ' ' If Not validation("valid") Then ' ' ' 记录验证错误 ' ' End If ' ------------------------------------------------------------------------------ Public Function ValidateComponentCombination(ByVal materials As Collection) As Object On Error GoTo ErrorHandler Dim result As Object Set result = CreateObject("Scripting.Dictionary") If materials Is Nothing Or materials.count = 0 Then result("valid") = False result("message") = "物料列表为空" Set ValidateComponentCombination = result Exit Function End If ' 统计各类型物料数量 Dim componentCount As Long Dim jointCount As Long Dim elementCount As Long Dim otherCount As Long componentCount = 0 jointCount = 0 elementCount = 0 otherCount = 0 Dim mat As Variant For Each mat In materials Dim matType As String matType = CStr(mat("materialType")) Select Case matType Case "部件" componentCount = componentCount + 1 Case "接头" jointCount = jointCount + 1 Case "弹性元件" elementCount = elementCount + 1 Case Else otherCount = otherCount + 1 End Select Next mat ' 验证组合规则 ' 规则1: 只有1个部件,没有接头和弹性元件 If componentCount = 1 And jointCount = 0 And elementCount = 0 Then result("valid") = True result("message") = "验证通过:1个部件" Set ValidateComponentCombination = result Exit Function End If ' 规则2: 没有部件,恰好1个接头和1个弹性元件 If componentCount = 0 And jointCount = 1 And elementCount = 1 Then result("valid") = True result("message") = "验证通过:1个接头+1个弹性元件" Set ValidateComponentCombination = result Exit Function End If ' 其他情况都是异常 Dim errorMsg As String errorMsg = "部件组合异常: " If componentCount > 1 Then errorMsg = errorMsg & "部件数量为" & componentCount & "(应为1)" ElseIf componentCount = 1 And (jointCount > 0 Or elementCount > 0) Then errorMsg = errorMsg & "同时存在部件和子件(不应共存)" ElseIf jointCount <> elementCount Then errorMsg = errorMsg & "接头数量(" & jointCount & ")≠弹性元件数量(" & elementCount & ")" ElseIf jointCount = 0 And elementCount = 0 Then errorMsg = errorMsg & "缺少部件和子件" Else errorMsg = errorMsg & "未知异常组合" End If result("valid") = False result("message") = errorMsg Set ValidateComponentCombination = result Exit Function ErrorHandler: result("valid") = False result("message") = "验证过程发生错误: " & err.Description Set ValidateComponentCombination = result End Function