From 726bbe211885bbc6dc5c7ce03b209197cbe628cf Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Tue, 3 Feb 2026 12:26:51 +0800 Subject: [PATCH] chore: remove all VBA source files - Remove all VBA source files from ClassModules, DocumentModules, and Modules - Remove vba_metadata.json Co-Authored-By: Claude Sonnet 4.5 --- VBA/ClassModules/BomExtractor.cls | 482 ------------------ VBA/ClassModules/BomItem.cls | 86 ---- VBA/ClassModules/ConditionEvaluator.cls | 224 -------- VBA/ClassModules/ProductModelParser.cls | 303 ----------- VBA/DocumentModules/Sheet9.cls | 16 - VBA/Modules/BIPUploadModule.bas | 420 --------------- VBA/Modules/ComponentInventoryCheckModule.bas | 470 ----------------- VBA/Modules/MainModule.bas | 430 ---------------- VBA/Modules/TestModule.bas | 336 ------------ VBA/vba_metadata.json | 53 -- 10 files changed, 2820 deletions(-) delete mode 100644 VBA/ClassModules/BomExtractor.cls delete mode 100644 VBA/ClassModules/BomItem.cls delete mode 100644 VBA/ClassModules/ConditionEvaluator.cls delete mode 100644 VBA/ClassModules/ProductModelParser.cls delete mode 100644 VBA/DocumentModules/Sheet9.cls delete mode 100644 VBA/Modules/BIPUploadModule.bas delete mode 100644 VBA/Modules/ComponentInventoryCheckModule.bas delete mode 100644 VBA/Modules/MainModule.bas delete mode 100644 VBA/Modules/TestModule.bas delete mode 100644 VBA/vba_metadata.json diff --git a/VBA/ClassModules/BomExtractor.cls b/VBA/ClassModules/BomExtractor.cls deleted file mode 100644 index 72bddea..0000000 --- a/VBA/ClassModules/BomExtractor.cls +++ /dev/null @@ -1,482 +0,0 @@ -'===================================================================== -' 类名: BomExtractor -' 功能: BOM提取器,从平台配置清单中提取匹配的物料 -'===================================================================== - -Option Explicit - -Private pWorksheet As Worksheet -Private pConditionEvaluator As ConditionEvaluator -Private pAllItems As collection ' 所有BOM项 -Private pMatchedItems As collection ' 匹配的BOM项 -Private pRequiredCategories As collection ' 需要的类别 -Private pCategoryHierarchy As Object ' 类别层次结构 Dictionary(子类别->父类别) -Private pErrorMessages As collection -Private pExcludeCategories As collection ' 需要排除的类别 - -'===================================================================== -' 方法: Class_Initialize -' 功能: 初始化类 -'===================================================================== -Private Sub Class_Initialize() - Set pConditionEvaluator = New ConditionEvaluator - Set pAllItems = New collection - Set pMatchedItems = New collection - Set pRequiredCategories = New collection - Set pCategoryHierarchy = CreateObject("Scripting.Dictionary") - Set pErrorMessages = New collection - Set pExcludeCategories = New collection -End Sub - -'===================================================================== -' 方法: SetWorksheet -' 功能: 设置BOM数据源工作表 -' 参数: ws - 工作表对象 -'===================================================================== -Public Sub SetWorksheet(ws As Worksheet) - Set pWorksheet = ws -End Sub - -'===================================================================== -' 方法: LoadBomData -' 功能: 加载BOM数据 -' 返回: Boolean - 成功返回True -'===================================================================== -Public Function LoadBomData() As Boolean - On Error GoTo ErrorHandler - - If pWorksheet Is Nothing Then - pErrorMessages.Add "未设置工作表" - LoadBomData = False - Exit Function - End If - - ' 清空现有数据 - Set pAllItems = New collection - Set pCategoryHierarchy = CreateObject("Scripting.Dictionary") - - ' 从第4行开始读取(第3行是表头) - Dim lastRow As Long - lastRow = pWorksheet.Cells(pWorksheet.Rows.Count, 1).End(xlUp).row - - Dim i As Long - Dim item As BomItem - - For i = 4 To lastRow - ' 检查行号是否为空 - If Trim(pWorksheet.Cells(i, 1).value) <> "" Then - Set item = New BomItem - item.LoadFromRow pWorksheet, i - - ' 只添加有效物料(类别不为空) - If item.IsValidItem Then - pAllItems.Add item - - ' 构建类别层次结构 - If item.HasParentCategory Then - If Not pCategoryHierarchy.Exists(item.category) Then - pCategoryHierarchy.Add item.category, item.ParentCategory - End If - End If - Else - ' 非有效物料也添加,但标记为特殊类别 - pAllItems.Add item - End If - End If - Next i - - LoadBomData = True - Exit Function - -ErrorHandler: - pErrorMessages.Add "加载BOM数据异常: " & Err.description - LoadBomData = False -End Function - -'===================================================================== -' 方法: SetExcludeCategories -' 功能: 设置需要排除的类别 -' 参数: categories - 类别集合 -'===================================================================== -Public Sub SetExcludeCategories(categories As collection) - Set pExcludeCategories = categories -End Sub - -'===================================================================== -' 方法: ClearExcludeCategories -' 功能: 清空排除类别列表 -'===================================================================== -Public Sub ClearExcludeCategories() - Set pExcludeCategories = New collection -End Sub - -'===================================================================== -' 方法: ClearErrorMessages -' 功能: 清空错误信息列表 -'===================================================================== -Public Sub ClearErrorMessages() - Set pErrorMessages = New collection -End Sub - -'===================================================================== -' 方法: ExtractBom -' 功能: 根据产品条件提取BOM -' 参数: productConditions - 产品条件字典 -' 返回: Collection - 匹配的BOM项集合 -'===================================================================== -Public Function ExtractBom(productConditions As Object) As collection - On Error GoTo ErrorHandler - - ' 清空结果 - Set pMatchedItems = New collection - Set pRequiredCategories = New collection - Set pErrorMessages = New collection - - ' 第一步:确定需要的类别 - DetermineRequiredCategories productConditions - - ' 第二步:匹配物料 - MatchItems productConditions - - ' 第三步:应用总成逻辑(父类别优先) - ApplyAssemblyLogic - - ' 第四步:验证结果 - ValidateResult - - Set ExtractBom = pMatchedItems - Exit Function - -ErrorHandler: - pErrorMessages.Add "提取BOM异常: " & Err.description - Set ExtractBom = pMatchedItems -End Function - -'===================================================================== -' 方法: DetermineRequiredCategories -' 功能: 确定需要的类别 -' 参数: productConditions - 产品条件字典 -'===================================================================== -Private Sub DetermineRequiredCategories(productConditions As Object) - Dim item As BomItem - Dim uniqueCategories As Object - Set uniqueCategories = CreateObject("Scripting.Dictionary") - - ' 遍历所有有效物料,获取唯一类别 - For Each item In pAllItems - If item.IsValidItem Then - ' 检查是否在排除列表中 - Dim isExcluded As Boolean - isExcluded = False - Dim excludeCat As Variant - For Each excludeCat In pExcludeCategories - If item.category = CStr(excludeCat) Then - isExcluded = True - Exit For - End If - Next excludeCat - - ' 如果不在排除列表中，继续处理 - If Not isExcluded Then - ' 检查类别选用条件 - Dim categoryRequired As Boolean - If Trim(item.CategoryCondition) = "" Then - ' 无条件,必需类别 - categoryRequired = True - Else - ' 有条件,评估条件 - categoryRequired = pConditionEvaluator.Evaluate(item.CategoryCondition, productConditions) - End If - - If categoryRequired Then - If Not uniqueCategories.Exists(item.category) Then - uniqueCategories.Add item.category, True - pRequiredCategories.Add item.category - End If - End If - End If - End If - Next item -End Sub - -'===================================================================== -' 方法: MatchItems -' 功能: 匹配物料 -' 修改说明: 当未匹配到物料(Count=0)时不再立即报错，而是留给 ValidateResult -' 进行综合判断（因为可能存在父子覆盖或散件满足的情况）。 -'===================================================================== -Private Sub MatchItems(productConditions As Object) - Dim item As BomItem - Dim category As Variant - - ' 遍历每个需要的类别 - For Each category In pRequiredCategories - Dim categoryMatches As collection - Set categoryMatches = New collection - - ' 查找该类别下所有匹配的物料 - For Each item In pAllItems - If item.category = category Then - ' 评估选择条件 - Dim matched As Boolean - If Trim(item.SelectCondition) = "" Then - ' 无选择条件,无条件匹配 - matched = True - Else - ' 有选择条件,评估 - matched = pConditionEvaluator.Evaluate(item.SelectCondition, productConditions) - End If - - If matched Then - item.IsMatched = True - categoryMatches.Add item - End If - End If - Next item - - ' 检查匹配结果 - If categoryMatches.Count = 0 Then - ' --------------------------------------------------------- - ' CHANGE: 这里不再立即报错 - ' 理由: 未匹配到可能是正常的（例如：父类别缺失但子类别齐全，或者子类别被父类别覆盖） - ' 具体的缺失检查移交到 ValidateResult 方法中统一处理 - ' --------------------------------------------------------- - ElseIf categoryMatches.Count = 1 Then - ' 正常:匹配到1条 - pMatchedItems.Add categoryMatches(1) - Else - ' 异常:匹配到多条 (这个依然需要报错，因为这是数据源的不确定性错误) - Dim multiMsg As String - multiMsg = "类别[" & category & "]匹配到多条物料(" & categoryMatches.Count & "条)" - pErrorMessages.Add multiMsg - - ' 临时处理:输出所有匹配的 - Dim tempItem As BomItem - For Each tempItem In categoryMatches - tempItem.MatchError = multiMsg - pMatchedItems.Add tempItem - Next tempItem - End If - Next category -End Sub - -'===================================================================== -' 方法: ApplyAssemblyLogic -' 功能: 应用总成逻辑(父类别优先) -' 修改说明: 重构了算法，解决了以下问题： -' 1. 当某类别匹配到多条物料时，能够保留所有匹配项，而不是只输出第一条。 -' 2. 解决了因列表顺序不同导致子类别可能未被正确覆盖的潜在隐患。 -'===================================================================== -Private Sub ApplyAssemblyLogic() - ' 1. 构建父类别->子类别映射 - Dim parentToChildren As Object - Set parentToChildren = CreateObject("Scripting.Dictionary") - Dim parentCat As Variant - Dim childCat As Variant - Dim key As Variant - For Each key In pCategoryHierarchy.Keys - - - childCat = CStr(key) - parentCat = pCategoryHierarchy(key) - - If Not parentToChildren.Exists(parentCat) Then - Set parentToChildren(parentCat) = CreateObject("Scripting.Dictionary") - End If - parentToChildren(parentCat)(childCat) = True - Next key - - ' 2. 统计每个类别的匹配数量 - Dim categoryCounts As Object - Set categoryCounts = CreateObject("Scripting.Dictionary") - - Dim item As BomItem - For Each item In pMatchedItems - If Not categoryCounts.Exists(item.category) Then - categoryCounts(item.category) = 0 - End If - categoryCounts(item.category) = categoryCounts(item.category) + 1 - Next item - - ' 3. 识别符合"总成优先"条件的父类别 - ' 定义：如果父类别有且仅有1条匹配，且其所有子类别都有匹配，则视为满足总成逻辑 - Dim coveredCategories As Object - Set coveredCategories = CreateObject("Scripting.Dictionary") - - Dim satisfiedParentItems As collection - Set satisfiedParentItems = New collection - - For Each parentCat In parentToChildren.Keys - ' 只有当该父类别确实有匹配物料时才进行检查 - If categoryCounts.Exists(parentCat) Then - ' 条件1: 父类别只匹配到1条 (如果匹配多条，存在歧义，不应用覆盖逻辑，而是全部输出以供排查) - If categoryCounts(parentCat) = 1 Then - ' 条件2: 所有子类别都匹配到(至少1条) - Dim childrenMatched As Boolean - childrenMatched = True - - For Each childCat In parentToChildren(parentCat).Keys - If Not categoryCounts.Exists(childCat) Then - childrenMatched = False - Exit For - End If - Next childCat - - If childrenMatched Then - ' 满足总成条件: 找到那个父类别项 - Dim pItem As BomItem - For Each item In pMatchedItems - If item.category = parentCat Then - satisfiedParentItems.Add item - Exit For - End If - Next item - - ' 标记覆盖的类别(父类别自己和所有子类别都标记为已处理) - ' 这样做的目的是：在步骤4中，我们会先添加 satisfiedParentItems， - ' 然后跳过 coveredCategories 中的项，从而实现"父类覆盖子类"且"父类不重复添加" - coveredCategories(parentCat) = True - For Each childCat In parentToChildren(parentCat).Keys - coveredCategories(childCat) = True - Next childCat - End If - End If - End If - Next parentCat - - ' 4. 构建新的结果集 - Dim newMatchedItems As collection - Set newMatchedItems = New collection - - ' 4.1 先添加满足条件的父类别项 (总成) - For Each item In satisfiedParentItems - newMatchedItems.Add item - Next item - - ' 4.2 再添加未被覆盖的其他项 (散件 或 有问题的多条匹配项) - For Each item In pMatchedItems - ' 如果该项所属的类别不在"被覆盖"列表中，则保留 - ' 关键点：这里不再去重！如果同一个Category有5条记录，这5条都会因为不在coveredCategories中而被添加 - If Not coveredCategories.Exists(item.category) Then - newMatchedItems.Add item - End If - Next item - - ' 更新结果 - Set pMatchedItems = newMatchedItems -End Sub - -'===================================================================== -' 方法: ValidateResult -' 功能: 验证提取结果 -' 修改说明: 实现了双向覆盖检查： -' 1. 子类别缺失，但父类别存在 -> 视为正常 (总成优先) -' 2. 父类别缺失，但所有必需子类别都存在 -> 视为正常 (散件满足) -'===================================================================== -Private Sub ValidateResult() - ' 检查所有需要的类别是否都匹配 - Dim category As Variant - Dim categoryMatched As Object - Set categoryMatched = CreateObject("Scripting.Dictionary") - - ' 统计已匹配的类别 - Dim item As BomItem - For Each item In pMatchedItems - If Not categoryMatched.Exists(item.category) Then - categoryMatched(item.category) = 0 - End If - categoryMatched(item.category) = categoryMatched(item.category) + 1 - Next item - - ' 检查未匹配的类别 - For Each category In pRequiredCategories - ' 如果结果集中不存在该必需类别 - If Not categoryMatched.Exists(category) Then - - Dim isResolved As Boolean - isResolved = False - - ' --------------------------------------------------------- - ' 检查 1: 被父类别覆盖 (总成逻辑) - ' 场景: 匹配到了部件(父)，自动隐藏了接头(子)，接头不应报错 - ' --------------------------------------------------------- - If pCategoryHierarchy.Exists(category) Then - Dim parentCat As String - parentCat = pCategoryHierarchy(category) - - If categoryMatched.Exists(parentCat) Then - isResolved = True - End If - End If - - ' --------------------------------------------------------- - ' 检查 2: 被子类别覆盖 (散件逻辑) - ' 场景: 部件(父)没匹配到(或被移除)，但接头(子)和弹性元件(子)都齐了，部件不应报错 - ' --------------------------------------------------------- - If Not isResolved Then - Dim hasRequiredChildren As Boolean - Dim allChildrenMatched As Boolean - - hasRequiredChildren = False - allChildrenMatched = True - - ' 遍历所有"必需"的类别，寻找当前缺失category的子类别 - Dim reqCat As Variant - For Each reqCat In pRequiredCategories - ' 如果 reqCat 是当前 category 的子类别 - If pCategoryHierarchy.Exists(reqCat) Then - If pCategoryHierarchy(reqCat) = category Then - hasRequiredChildren = True - - ' 检查这个子类别是否在结果集中 - If Not categoryMatched.Exists(reqCat) Then - allChildrenMatched = False - Exit For ' 只要缺一个子类别，父类别就无法被视为"满足" - End If - End If - End If - Next reqCat - - ' 只有当存在必需子类别，且它们全都匹配时，才算通过 - If hasRequiredChildren And allChildrenMatched Then - isResolved = True - End If - End If - - ' --------------------------------------------------------- - ' 最终判断 - ' --------------------------------------------------------- - If Not isResolved Then - pErrorMessages.Add "必需类别[" & category & "]未匹配" - End If - - End If - Next category -End Sub - -'===================================================================== -' 方法: GetErrorMessages -' 功能: 获取错误信息集合 -' 返回: Collection -'===================================================================== -Public Function GetErrorMessages() As collection - Set GetErrorMessages = pErrorMessages -End Function - -'===================================================================== -' 方法: GetErrorSummary -' 功能: 获取错误信息摘要 -' 返回: String -'===================================================================== -Public Function GetErrorSummary() As String - If pErrorMessages.Count = 0 Then - GetErrorSummary = "" - Else - Dim result As String - Dim msg As Variant - For Each msg In pErrorMessages - result = result & CStr(msg) & "; " - Next msg - GetErrorSummary = result - End If -End Function \ No newline at end of file diff --git a/VBA/ClassModules/BomItem.cls b/VBA/ClassModules/BomItem.cls deleted file mode 100644 index 6b224e7..0000000 --- a/VBA/ClassModules/BomItem.cls +++ /dev/null @@ -1,86 +0,0 @@ -'===================================================================== -' 类名: BomItem -' 功能: BOM物料项数据模型 -'===================================================================== - -Option Explicit - -' 物料属性 -Public RowNumber As Long ' 行号 -Public Module As String ' 模块 -Public code As String ' 代号 -Public Name As String ' 名称 -Public quantity As Double ' 数量 -Public SelectCondition As String ' 选择条件 -Public Remark As String ' 备注 -Public category As String ' 类别 -Public ParentCategory As String ' 上层类别 -Public CategoryCondition As String ' 类别选用条件 -Public Code66 As String ' 66代码 - -' 匹配状态 -Public IsMatched As Boolean ' 是否匹配 -Public MatchError As String ' 匹配错误信息 - -'===================================================================== -' 方法: Class_Initialize -' 功能: 初始化类 -'===================================================================== -Private Sub Class_Initialize() - IsMatched = False - MatchError = "" -End Sub - -'===================================================================== -' 方法: LoadFromRow -' 功能: 从工作表行加载数据 -' 参数: ws - 工作表对象 -' row - 行号 -'===================================================================== -Public Sub LoadFromRow(ws As Worksheet, row As Long) - On Error Resume Next - - Me.RowNumber = CLng(ws.Cells(row, 1).value) ' A列: 行号 - Me.Module = CStr(ws.Cells(row, 2).value) ' B列: 模块 - Me.code = CStr(ws.Cells(row, 3).value) ' C列: 代号 - Me.Name = CStr(ws.Cells(row, 4).value) ' D列: 名称 - Me.quantity = CDbl(ws.Cells(row, 5).value) ' E列: 数量 - Me.SelectCondition = CStr(ws.Cells(row, 6).value) ' F列: 选择条件 - Me.Remark = CStr(ws.Cells(row, 7).value) ' G列: 备注 - Me.category = CStr(ws.Cells(row, 8).value) ' H列: 类别 - Me.ParentCategory = CStr(ws.Cells(row, 9).value) ' I列: 上层类别 - Me.CategoryCondition = CStr(ws.Cells(row, 10).value) ' J列: 类别选用条件 - Me.Code66 = CStr(ws.Cells(row, 11).value) ' K列: 66代码 - - On Error GoTo 0 -End Sub - -'===================================================================== -' 方法: IsValidItem -' 功能: 判断是否为有效物料(类别字段不为空) -' 返回: Boolean -'===================================================================== -Public Function IsValidItem() As Boolean - IsValidItem = (Trim(Me.category) <> "") -End Function - -'===================================================================== -' 方法: HasParentCategory -' 功能: 判断是否有父类别 -' 返回: Boolean -'===================================================================== -Public Function HasParentCategory() As Boolean - HasParentCategory = (Trim(Me.ParentCategory) <> "") -End Function - -'===================================================================== -' 方法: ToString -' 功能: 转换为字符串描述 -' 返回: String -'===================================================================== -Public Function ToString() As String - ToString = "行号:" & Me.RowNumber & _ - " | 类别:" & Me.category & _ - " | 代号:" & Me.code & _ - " | 名称:" & Me.Name -End Function \ No newline at end of file diff --git a/VBA/ClassModules/ConditionEvaluator.cls b/VBA/ClassModules/ConditionEvaluator.cls deleted file mode 100644 index bf068e3..0000000 --- a/VBA/ClassModules/ConditionEvaluator.cls +++ /dev/null @@ -1,224 +0,0 @@ -'===================================================================== -' 类名: ConditionEvaluator -' 功能: 解析和评估条件表达式 -'===================================================================== - -Option Explicit - -'===================================================================== -' 方法: Evaluate -' 功能: 评估条件表达式 -' 参数: expression - 条件表达式字符串 -' productConditions - 产品条件字典(Dictionary对象) -' 返回: Boolean - True表示条件满足,False表示不满足 -' 说明: 支持AND、OR、!=运算符和括号嵌套 -' 特殊规则:如果表达式中要求!=某值,而产品条件中不存在该变量,视为满足条件 -'===================================================================== -Public Function Evaluate(expression As String, productConditions As Object) As Boolean - On Error GoTo ErrorHandler - - ' 空条件视为满足 - If Trim(expression) = "" Then - Evaluate = True - Exit Function - End If - - ' 递归解析表达式 - Evaluate = EvaluateExpression(Trim(expression), productConditions) - Exit Function - -ErrorHandler: - ' 解析错误时返回False - Evaluate = False -End Function - -'===================================================================== -' 方法: EvaluateExpression -' 功能: 递归评估表达式 -' 参数: expr - 表达式 -' conditions - 条件字典 -' 返回: Boolean -'===================================================================== -Private Function EvaluateExpression(expr As String, Conditions As Object) As Boolean - expr = Trim(expr) - - ' 处理最外层括号 - If Left(expr, 1) = "(" And Right(expr, 1) = ")" Then - If IsMatchedParentheses(expr) Then - expr = Mid(expr, 2, Len(expr) - 2) - expr = Trim(expr) - End If - End If - - ' 处理OR运算符(优先级最低) - Dim orResult As Variant - orResult = SplitByOperator(expr, " OR ", Conditions) - If Not IsEmpty(orResult) Then - EvaluateExpression = orResult - Exit Function - End If - - ' 处理AND运算符 - Dim andResult As Variant - andResult = SplitByOperator(expr, " AND ", Conditions) - If Not IsEmpty(andResult) Then - EvaluateExpression = andResult - Exit Function - End If - - ' 处理单个条件 - EvaluateExpression = EvaluateSingleCondition(expr, Conditions) -End Function - -'===================================================================== -' 方法: SplitByOperator -' 功能: 按指定运算符分割并评估表达式 -' 参数: expr - 表达式 -' operator - 运算符(" OR " 或 " AND ") -' conditions - 条件字典 -' 返回: Variant - 评估结果或Empty -'===================================================================== -Private Function SplitByOperator(expr As String, operator As String, Conditions As Object) As Variant - Dim pos As Long - Dim leftPart As String - Dim rightPart As String - Dim depth As Long - Dim i As Long - Dim char As String - - ' 寻找不在括号内的运算符 - depth = 0 - For i = 1 To Len(expr) - Len(operator) + 1 - char = Mid(expr, i, 1) - - If char = "(" Then - depth = depth + 1 - ElseIf char = ")" Then - depth = depth - 1 - ElseIf depth = 0 Then - ' 检查是否匹配运算符 - If Mid(expr, i, Len(operator)) = operator Then - leftPart = Trim(Left(expr, i - 1)) - rightPart = Trim(Mid(expr, i + Len(operator))) - - ' 根据运算符类型评估 - If operator = " OR " Then - SplitByOperator = EvaluateExpression(leftPart, Conditions) Or _ - EvaluateExpression(rightPart, Conditions) - ElseIf operator = " AND " Then - SplitByOperator = EvaluateExpression(leftPart, Conditions) And _ - EvaluateExpression(rightPart, Conditions) - End If - Exit Function - End If - End If - Next i - - ' 未找到运算符 - SplitByOperator = Empty -End Function - -'===================================================================== -' 方法: EvaluateSingleCondition -' 功能: 评估单个条件(如 azxs=A0 或 azxs!=AH) -' 参数: condition - 单个条件字符串 -' conditions - 条件字典 -' 返回: Boolean -'===================================================================== -Private Function EvaluateSingleCondition(condition As String, Conditions As Object) As Boolean - Dim varName As String - Dim operator As String - Dim value As String - Dim actualValue As String - - condition = Trim(condition) - - ' 检查!=运算符 - If InStr(condition, "!=") > 0 Then - Dim parts() As String - parts = Split(condition, "!=") - If UBound(parts) >= 1 Then - varName = Trim(parts(0)) - value = Trim(parts(1)) - - ' 特殊规则:如果产品条件中不存在该变量,视为满足!=条件 - If Not Conditions.Exists(varName) Then - EvaluateSingleCondition = True - Else - actualValue = Conditions(varName) - - ' fjgn字段特殊处理（多值匹配） - If varName = "fjgn" Then - ' fjgn!=N1：检查actualValue中是否不包含value - EvaluateSingleCondition = (InStr(actualValue, value) = 0) - Else - ' 其他字段使用精确匹配 - EvaluateSingleCondition = (actualValue <> value) - End If - End If - Exit Function - End If - End If - - ' 检查=运算符 - If InStr(condition, "=") > 0 Then - Dim eqParts() As String - eqParts = Split(condition, "=") - If UBound(eqParts) >= 1 Then - varName = Trim(eqParts(0)) - value = Trim(eqParts(1)) - - If Not Conditions.Exists(varName) Then - EvaluateSingleCondition = False - Else - actualValue = Conditions(varName) - - ' fjgn字段特殊处理（多值匹配） - If varName = "fjgn" Then - ' fjgn=N1：检查actualValue中是否包含value - EvaluateSingleCondition = (InStr(actualValue, value) > 0) - Else - ' 其他字段使用精确匹配 - EvaluateSingleCondition = (actualValue = value) - End If - End If - Exit Function - End If - End If - - ' 无法解析的条件返回False - EvaluateSingleCondition = False -End Function - -'===================================================================== -' 方法: IsMatchedParentheses -' 功能: 检查字符串最外层括号是否匹配 -' 参数: str - 字符串 -' 返回: Boolean -'===================================================================== -Private Function IsMatchedParentheses(str As String) As Boolean - If Left(str, 1) <> "(" Or Right(str, 1) <> ")" Then - IsMatchedParentheses = False - Exit Function - End If - - Dim depth As Long - Dim i As Long - - depth = 0 - For i = 1 To Len(str) - If Mid(str, i, 1) = "(" Then - depth = depth + 1 - ElseIf Mid(str, i, 1) = ")" Then - depth = depth - 1 - End If - - ' 如果在中间某处深度归零,说明最外层括号不匹配 - If depth = 0 And i < Len(str) Then - IsMatchedParentheses = False - Exit Function - End If - Next i - - IsMatchedParentheses = (depth = 0) -End Function \ No newline at end of file diff --git a/VBA/ClassModules/ProductModelParser.cls b/VBA/ClassModules/ProductModelParser.cls deleted file mode 100644 index f9c7594..0000000 --- a/VBA/ClassModules/ProductModelParser.cls +++ /dev/null @@ -1,303 +0,0 @@ -'===================================================================== -' 类名: ProductModelParser -' 功能: 解析产品型号并提取物料选择条件 -'===================================================================== - -Option Explicit - -Private pFullModel As String -Private pHeaderModel As String -Private pConditions As Object ' Dictionary -Private pErrorMessage As String - -'===================================================================== -' 属性: FullModel - 完整产品型号 -'===================================================================== -Public Property Get FullModel() As String - FullModel = pFullModel -End Property - -Public Property Let FullModel(value As String) - pFullModel = value -End Property - -'===================================================================== -' 属性: HeaderModel - 表头型号 -'===================================================================== -Public Property Get HeaderModel() As String - HeaderModel = pHeaderModel -End Property - -'===================================================================== -' 属性: Conditions - 提取的条件字典 -'===================================================================== -Public Property Get Conditions() As Object - Set Conditions = pConditions -End Property - -'===================================================================== -' 属性: ErrorMessage - 错误信息 -'===================================================================== -Public Property Get ErrorMessage() As String - ErrorMessage = pErrorMessage -End Property - -'===================================================================== -' 方法: Class_Initialize -' 功能: 初始化类 -'===================================================================== -Private Sub Class_Initialize() - Set pConditions = CreateObject("Scripting.Dictionary") - pErrorMessage = "" -End Sub - -'===================================================================== -' 方法: Parse -' 功能: 解析产品型号 -' 参数: modelString - 完整产品型号字符串 -' 返回: Boolean - True表示解析成功,False表示失败 -'===================================================================== -Public Function Parse(modelString As String) As Boolean - On Error GoTo ErrorHandler - - pFullModel = Trim(modelString) - pConditions.RemoveAll - pErrorMessage = "" - - ' 提取表头部分(|之前的部分) - Dim parts() As String - parts = Split(pFullModel, "|") - - If UBound(parts) < 0 Then - pErrorMessage = "型号格式错误:缺少表头部分" - Parse = False - Exit Function - End If - - pHeaderModel = Trim(parts(0)) - - ' 解析表头型号 - If Not ParseHeader() Then - Parse = False - Exit Function - End If - - Parse = True - Exit Function - -ErrorHandler: - pErrorMessage = "解析异常: " & Err.description - Parse = False -End Function - -'===================================================================== -' 方法: ParseHeader -' 功能: 解析表头型号结构 -' 返回: Boolean - True表示解析成功 -' 说明: 表头结构 [型号]-[公称外径].[安装形式].[壳体形式].[过程连接&接液材质].[量程范围].[仪表特性] -'===================================================================== -Private Function ParseHeader() As Boolean - On Error GoTo ErrorHandler - - ' 分离型号和其余部分 - Dim dashParts() As String - dashParts = Split(pHeaderModel, "-") - - If UBound(dashParts) < 1 Then - pErrorMessage = "表头格式错误:缺少'-'分隔符" - ParseHeader = False - Exit Function - End If - - ' 分离各个字段(用.分隔) - Dim dotParts() As String - dotParts = Split(dashParts(1), ".") - - ' 验证结构完整性:至少需要5个部分(公称外径、安装形式、壳体形式、过程连接、量程) - If UBound(dotParts) < 4 Then - pErrorMessage = "表头结构不完整:缺少必要字段" - ParseHeader = False - Exit Function - End If - - ' 提取各个条件 - ' 安装形式 - 第2个位置(索引1) - Dim azxs As String - azxs = Trim(dotParts(1)) - pConditions.Add "azxs", azxs - - ' 表壳形式 - 第3个位置(索引2) - Dim bkxs As String - bkxs = Trim(dotParts(2)) - pConditions.Add "bkxs", bkxs - - ' 过程连接和接液材质 - 第4个位置(索引3) - Dim connectionCode As String - connectionCode = Trim(dotParts(3)) - - Dim gclj As String - Dim jycz As String - If Not ExtractConnectionAndMaterial(connectionCode, gclj, jycz) Then - ParseHeader = False - Exit Function - End If - - pConditions.Add "gclj", gclj - pConditions.Add "jycz", jycz - - ' 量程范围 - 第5个位置(索引4) - Dim lcfw As String - lcfw = Trim(dotParts(4)) - pConditions.Add "lcfw", lcfw - - ' 仪表特性 - 第6个位置(索引5)及之后的所有部分 - ' 因为仪表特性中可能包含.分隔符(如N3.N2.Y3)，所以需要合并从索引5开始的所有部分 - Dim fjgn As String - If UBound(dotParts) >= 5 Then - Dim instrumentFeature As String - Dim i As Long - instrumentFeature = "" - - ' 合并从索引5开始的所有部分，用.连接 - For i = 5 To UBound(dotParts) - If instrumentFeature = "" Then - instrumentFeature = dotParts(i) - Else - instrumentFeature = instrumentFeature & "." & dotParts(i) - End If - Next i - - instrumentFeature = Trim(instrumentFeature) - fjgn = ExtractAdditionalFeatures(instrumentFeature) - Else - ' 如果没有仪表特性字段，fjgn为空 - fjgn = "" - End If - pConditions.Add "fjgn", fjgn - - ParseHeader = True - Exit Function - -ErrorHandler: - pErrorMessage = "解析表头异常: " & Err.description - ParseHeader = False -End Function - -'===================================================================== -' 方法: ExtractConnectionAndMaterial -' 功能: 从过程连接代码中提取过程连接和接液材质 -' 参数: code - 过程连接代码(如M203) -' outConnection - 输出:过程连接(如M20) -' outMaterial - 输出:接液材质(如3) -' 返回: Boolean - True表示提取成功 -' 说明: 材质代码为最后一位数字,其余为螺纹代码 -'===================================================================== -Private Function ExtractConnectionAndMaterial(code As String, _ - ByRef outConnection As String, _ - ByRef outMaterial As String) As Boolean - On Error GoTo ErrorHandler - - If Len(code) < 2 Then - pErrorMessage = "过程连接代码格式错误:长度不足" - ExtractConnectionAndMaterial = False - Exit Function - End If - - ' 材质代码是最后一位数字 - Dim lastChar As String - lastChar = Right(code, 1) - - ' 验证最后一位是否为数字 - If Not IsNumeric(lastChar) Then - pErrorMessage = "过程连接代码格式错误:最后一位不是数字" - ExtractConnectionAndMaterial = False - Exit Function - End If - - outMaterial = lastChar - outConnection = Left(code, Len(code) - 1) - - ExtractConnectionAndMaterial = True - Exit Function - -ErrorHandler: - pErrorMessage = "提取过程连接和材质异常: " & Err.description - ExtractConnectionAndMaterial = False -End Function - -'===================================================================== -' 方法: GetConditionValue -' 功能: 获取指定条件的值 -' 参数: conditionName - 条件名称 -' 返回: String - 条件值,如果不存在返回空字符串 -'===================================================================== -Public Function GetConditionValue(conditionName As String) As String - If pConditions.Exists(conditionName) Then - GetConditionValue = pConditions(conditionName) - Else - GetConditionValue = "" - End If -End Function - -'===================================================================== -' 方法: GetAllConditions -' 功能: 获取所有条件的描述文本 -' 返回: String - 条件描述文本 -'===================================================================== -Public Function GetAllConditions() As String - Dim result As String - Dim key As Variant - - result = "" - For Each key In pConditions.Keys - result = result & key & "=" & pConditions(key) & "; " - Next key - - GetAllConditions = result -End Function - -'===================================================================== -' 方法: ExtractAdditionalFeatures -' 功能: 从仪表特性中提取附加功能 -' 参数: instrumentFeature - 仪表特性字符串(如"N2,N3.Y3"或"Y3") -' 返回: String - 附加功能字符串，多个功能用逗号分隔 -' 说明: -' 1. 识别并去除充油类型(位于最后，格式为Y+一位数字) -' 2. 统一分隔符处理(将.替换为,) -' 3. 去除可能的后缀分隔符 -'===================================================================== -Private Function ExtractAdditionalFeatures(instrumentFeature As String) As String - On Error GoTo ErrorHandler - - Dim result As String - result = Trim(instrumentFeature) - - ' 1. 检查是否以Y+数字结尾（充油类型） - If Len(result) >= 2 Then - Dim lastTwoChars As String - lastTwoChars = Right(result, 2) - - ' 检查最后两位是否为Y+数字 - If UCase(Left(lastTwoChars, 1)) = "Y" And IsNumeric(Right(lastTwoChars, 1)) Then - ' 去掉充油类型 - result = Left(result, Len(result) - 2) - result = Trim(result) - End If - End If - - ' 2. 处理可能的分隔符（,或.） - ' 将可能的.替换为,，统一处理 - result = Replace(result, ".", ",") - - ' 3. 去除可能的后缀分隔符 - If Len(result) > 0 And Right(result, 1) = "," Then - result = Left(result, Len(result) - 1) - End If - - ExtractAdditionalFeatures = Trim(result) - Exit Function - -ErrorHandler: - ' 如果解析出错，返回空字符串 - ExtractAdditionalFeatures = "" -End Function \ No newline at end of file diff --git a/VBA/DocumentModules/Sheet9.cls b/VBA/DocumentModules/Sheet9.cls deleted file mode 100644 index dc24cba..0000000 --- a/VBA/DocumentModules/Sheet9.cls +++ /dev/null @@ -1,16 +0,0 @@ -'===================================================================== -' 主按钮点击事件 -' 功能: 执行BOM提取和BIP上传 -'===================================================================== -Private Sub CommandButton1_Click() - Call ProcessProductModels - Call ProcessOrdersToBIP -End Sub - -'===================================================================== -' 部件库存核对按钮点击事件 -' 功能: 执行部件库存核对,标记库存不足的订单 -'===================================================================== -Private Sub CommandButton2_Click() - Call CheckComponentInventory -End Sub \ No newline at end of file diff --git a/VBA/Modules/BIPUploadModule.bas b/VBA/Modules/BIPUploadModule.bas deleted file mode 100644 index 302df40..0000000 --- a/VBA/Modules/BIPUploadModule.bas +++ /dev/null @@ -1,420 +0,0 @@ -'===================================================================== -' 模块名: BIPUploadModule -' 功能: 处理产品订单数据，提取BOM后生成[BIP上传模板]格式数据 -'===================================================================== - -Option Explicit - -'===================================================================== -' 常量定义 -'===================================================================== -' 提取条件配置 -Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能" -' 行号基数 -Private Const ROW_NUMBER_BASE = 7000 - -'===================================================================== -' 过程: ProcessOrdersToBIP -' 功能: 处理产品订单数据，生成BIP上传格式 -' 说明: 主入口程序，从[产品订单]读取数据，输出到[BIP上传模板] -'===================================================================== -Public Sub ProcessOrdersToBIP() - On Error GoTo ErrorHandler - - Dim startTime As Double - startTime = Timer - - ' 准备工作表对象 - Dim orderSheet As Worksheet - Dim bipSheet As Worksheet - Dim bomSheet As Worksheet - - ' 获取[产品订单]工作表 - Set orderSheet = GetOrderSheet() - If orderSheet Is Nothing Then - MsgBox "未找到[产品订单]工作表!", vbCritical - Exit Sub - End If - - ' 获取[BIP上传模板]工作表 - Set bipSheet = GetBIPUploadSheet() - - ' 获取BOM库工作表 - Set bomSheet = GetBomSheet() - If bomSheet Is Nothing Then - MsgBox "未找到[平台配置清单]工作表!", vbCritical - Exit Sub - End If - - ' 初始化BOM提取器 - Dim BomExtractor As BomExtractor - Set BomExtractor = New BomExtractor - BomExtractor.SetWorksheet bomSheet - - If Not BomExtractor.LoadBomData Then - MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical - Exit Sub - End If - - ' 清空BIP上传模板数据（保留表头） - ClearBIPSheetData bipSheet - - ' 写入BIP上传模板表头 - WriteBIPHeader bipSheet - - ' 获取订单数据行数 - Dim lastRow As Long - lastRow = orderSheet.Cells(orderSheet.Rows.Count, 1).End(xlUp).row - - ' 如果只有表头或没有数据 - If lastRow < 2 Then - MsgBox "[产品订单]工作表中没有数据!", vbExclamation - Exit Sub - End If - - ' 处理每个订单，收集所有输出数据 - Dim outputData As collection - Set outputData = New collection - - Dim i As Long - Dim processedCount As Long - Dim orderCount As Long - - processedCount = 0 - orderCount = 0 - - For i = 2 To lastRow - ' 读取订单数据 - Dim orderNumber As String - Dim productModel As String - Dim quantity As String - Dim productCode As String - Dim componentPriority As String - - orderNumber = Trim(orderSheet.Cells(i, 1).value) ' A列：生产订单号 - productModel = Trim(orderSheet.Cells(i, 2).value) ' B列：产品型号 - quantity = Trim(orderSheet.Cells(i, 3).value) ' C列：数量 - productCode = Trim(orderSheet.Cells(i, 4).value) ' D列：产品编码 - componentPriority = Trim(orderSheet.Cells(i, 5).value) ' E列：部件优先 - - ' 跳过空行 - If orderNumber = "" And productModel = "" Then - GoTo ContinueLoop - End If - - ' 验证必填字段 - If orderNumber = "" Then - MsgBox "第" & i & "行：生产订单号为空，跳过该行!", vbExclamation - GoTo ContinueLoop - End If - - If productModel = "" Then - MsgBox "第" & i & "行：产品型号为空，跳过该行!", vbExclamation - GoTo ContinueLoop - End If - - If quantity = "" Then - MsgBox "第" & i & "行：数量为空，跳过该行!", vbExclamation - GoTo ContinueLoop - End If - - orderCount = orderCount + 1 - - ' 处理单个订单，收集输出数据 - ProcessSingleOrder orderNumber, productModel, quantity, productCode, _ - componentPriority, BomExtractor, outputData - processedCount = processedCount + 1 - -ContinueLoop: - Next i - - ' 批量写入数据到工作表 - If outputData.Count > 0 Then - WriteBatchData bipSheet, outputData - End If - - ' 格式化BIP上传模板 - FormatBIPSheet bipSheet - - Dim elapsedTime As Double - elapsedTime = Timer - startTime - - MsgBox "处理完成!" & vbCrLf & _ - "处理订单数: " & orderCount & vbCrLf & _ - "生成BIP行数: " & outputData.Count & vbCrLf & _ - "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation - - ' 激活BIP上传模板 - bipSheet.Activate - - Exit Sub - -ErrorHandler: - MsgBox "处理异常: " & Err.description, vbCritical -End Sub - -'===================================================================== -' 过程: ProcessSingleOrder -' 功能: 处理单个订单，提取BOM并将数据添加到输出集合 -' 参数: orderNumber - 生产订单号 -' productModel - 产品型号 -' quantity - 生产数量 -' productCode - 产品编码 -' componentPriority - 部件优先标志（"是"或"否"） -' BomExtractor - BOM提取器对象 -' outputData - 输出数据集合 -'===================================================================== -Private Sub ProcessSingleOrder(orderNumber As String, _ - productModel As String, _ - quantity As String, _ - productCode As String, _ - componentPriority As String, _ - BomExtractor As BomExtractor, _ - outputData As collection) - On Error Resume Next - - ' 根据部件优先设置排除类别 - BomExtractor.ClearExcludeCategories - If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then - Dim excludeCats As New collection - excludeCats.Add "部件" - BomExtractor.SetExcludeCategories excludeCats - End If - - ' 解析产品型号 - Dim parser As ProductModelParser - Set parser = New ProductModelParser - - Dim extractNote As String - extractNote = "" - - If Not parser.Parse(productModel) Then - ' 解析失败，添加一行错误记录 - extractNote = "解析失败: " & parser.ErrorMessage - outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote) - Exit Sub - End If - - ' 提取BOM - Dim matchedItems As collection - Set matchedItems = BomExtractor.ExtractBom(parser.Conditions) - - ' 获取错误信息 - Dim bomErrors As String - bomErrors = BomExtractor.GetErrorSummary - If bomErrors <> "" Then - extractNote = bomErrors - End If - - ' 输出结果 - If matchedItems.Count = 0 Then - ' 没有匹配项，添加一行空记录 - If extractNote = "" Then - extractNote = "未匹配到任何物料" - End If - outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, 1, "", extractNote) - Else - ' 输出每个匹配的物料 - Dim item As BomItem - Dim lineIndex As Long - lineIndex = 1 - - For Each item In matchedItems - Dim itemNote As String - itemNote = extractNote - - ' 添加物料特定的错误 - If item.MatchError <> "" Then - If itemNote <> "" Then itemNote = itemNote & "; " - itemNote = itemNote & item.MatchError - End If - - ' 创建BIP行数据并添加到集合 - outputData.Add CreateBIPRowArray(orderNumber, productCode, quantity, _ - lineIndex, item.Code66, itemNote) - - lineIndex = lineIndex + 1 - Next item - End If -End Sub - -'===================================================================== -' 函数: CreateBIPRowArray -' 功能: 创建BIP上传模板一行数据的数组 -' 参数: orderNumber - 生产订单号 -' productCode - 产品编码 -' quantity - 生产数量 -' lineIndex - 行号索引（从1开始） -' materialCode - 材料编码（66编码） -' note - 备注 -' 返回: Variant() - 包含10个元素的数组 -'===================================================================== -Private Function CreateBIPRowArray(orderNumber As String, _ - productCode As String, _ - quantity As String, _ - lineIndex As Long, _ - materialCode As String, _ - note As String) As Variant() - Dim rowData(1 To 10) As Variant - - rowData(1) = orderNumber ' 来源单据号（生产订单号） - rowData(2) = productCode ' 产品编码 - rowData(3) = quantity ' 生产数量 - rowData(4) = ROW_NUMBER_BASE + lineIndex ' 行号 = 基数 + 索引 - rowData(5) = materialCode ' 材料编码（66编码） - rowData(6) = "一般发料" ' 供应方式（固定值） - rowData(7) = Date ' 需用日期（当天日期） - rowData(8) = "重庆布莱迪仪器仪表有限公司" ' 发料组织（固定值） - rowData(9) = quantity ' 计划出库数量（与生产数量一致） - rowData(10) = note ' 备注 - - CreateBIPRowArray = rowData -End Function - -'===================================================================== -' 过程: WriteBatchData -' 功能: 批量写入数据到工作表 -' 参数: ws - 工作表对象 -' outputData - 输出数据集合，每个元素是一个一维数组 -'===================================================================== -Private Sub WriteBatchData(ws As Worksheet, outputData As collection) - ' 如果没有数据，直接返回 - If outputData.Count = 0 Then - Exit Sub - End If - - ' 创建二维数组 - Dim rowCount As Long - rowCount = outputData.Count - - Dim resultData() As Variant - ReDim resultData(1 To rowCount, 1 To 10) - - ' 填充数据到二维数组 - Dim i As Long - Dim rowArray As Variant - - For i = 1 To rowCount - rowArray = outputData(i) - - resultData(i, 1) = rowArray(1) - resultData(i, 2) = rowArray(2) - resultData(i, 3) = rowArray(3) - resultData(i, 4) = rowArray(4) - resultData(i, 5) = rowArray(5) - resultData(i, 6) = rowArray(6) - resultData(i, 7) = rowArray(7) - resultData(i, 8) = rowArray(8) - resultData(i, 9) = rowArray(9) - resultData(i, 10) = rowArray(10) - Next i - - ' 一次性写入工作表（从第2行开始） - ws.Range("A2").Resize(rowCount, 10).value = resultData -End Sub - -'===================================================================== -' 过程: WriteBIPHeader -' 功能: 写入BIP上传模板表头 -' 参数: ws - 工作表对象 -'===================================================================== -Private Sub WriteBIPHeader(ws As Worksheet) - ' 第1行：主表头 - ws.Cells(1, 1).value = "来源单据号（生产订单号）" - ws.Cells(1, 2).value = "产品编码" - ws.Cells(1, 3).value = "生产数量" - ws.Cells(1, 4).value = "行号" - ws.Cells(1, 5).value = "材料编码" - ws.Cells(1, 6).value = "供应方式" - ws.Cells(1, 7).value = "需用日期" - ws.Cells(1, 8).value = "发料组织" - ws.Cells(1, 9).value = "计划出库数量" - ws.Cells(1, 10).value = "备注" -End Sub - -'===================================================================== -' 函数: GetOrderSheet -' 功能: 获取[产品订单]工作表 -' 返回: Worksheet - 工作表对象 -'===================================================================== -Private Function GetOrderSheet() As Worksheet - On Error Resume Next - Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单") - On Error GoTo 0 -End Function - -'===================================================================== -' 函数: GetBIPUploadSheet -' 功能: 获取或创建[BIP上传模板]工作表 -' 返回: Worksheet - 工作表对象 -'===================================================================== -Private Function GetBIPUploadSheet() As Worksheet - Dim wsName As String - wsName = "BIP上传模板" - - On Error Resume Next - Set GetBIPUploadSheet = ThisWorkbook.Worksheets(wsName) - On Error GoTo 0 - - If GetBIPUploadSheet Is Nothing Then - ' 创建新工作表 - Set GetBIPUploadSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) - GetBIPUploadSheet.Name = wsName - End If -End Function - -'===================================================================== -' 函数: GetBomSheet -' 功能: 获取BOM工作表 -' 返回: Worksheet - BOM工作表对象 -'===================================================================== -Private Function GetBomSheet() As Worksheet - On Error Resume Next - Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单") - On Error GoTo 0 -End Function - -'===================================================================== -' 过程: ClearBIPSheetData -' 功能: 清空BIP上传模板的数据（保留表头） -' 参数: ws - 工作表对象 -'===================================================================== -Private Sub ClearBIPSheetData(ws As Worksheet) - ' 清空从第2行开始的所有数据 - Dim lastRow As Long - lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row - - If lastRow > 1 Then - ws.Rows("2:" & lastRow).ClearContents - End If -End Sub - -'===================================================================== -' 过程: FormatBIPSheet -' 功能: 格式化BIP上传模板工作表 -' 参数: ws - 工作表对象 -'===================================================================== -Private Sub FormatBIPSheet(ws As Worksheet) - On Error Resume Next - - ' 设置表头格式 - With ws.Rows(1) - .Font.Bold = True - .Interior.Color = RGB(217, 217, 217) - .HorizontalAlignment = xlCenter - End With - - ' 设置所有单元格居中对齐 - With ws.UsedRange - .HorizontalAlignment = xlCenter - .VerticalAlignment = xlCenter - End With - - ' 自动调整列宽 - ws.Columns.AutoFit - - ' 设置日期列格式 - ws.Columns(7).NumberFormat = "yyyy/mm/dd" - - On Error GoTo 0 -End Sub \ No newline at end of file diff --git a/VBA/Modules/ComponentInventoryCheckModule.bas b/VBA/Modules/ComponentInventoryCheckModule.bas deleted file mode 100644 index eb476ca..0000000 --- a/VBA/Modules/ComponentInventoryCheckModule.bas +++ /dev/null @@ -1,470 +0,0 @@ -'===================================================================== -' 模块名: ComponentInventoryCheckModule -' 功能: 部件库存核对模块 - 自动核对产品订单中"部件"类物料的库存情况 -' 说明: 当库存不足时,按订单顺序将超出部分的订单的"部件优先"字段标记为"否" -'===================================================================== - -Option Explicit - -'===================================================================== -' 数据结构定义 - 使用字典以支持引用更新 -'===================================================================== - -' 订单字典键 -Private Const ORDER_ROW As String = "RowNumber" -Private Const ORDER_MODEL As String = "ProductModel" -Private Const ORDER_QUANTITY As String = "Quantity" -Private Const ORDER_COMP_CODE As String = "ComponentCode" -Private Const ORDER_COMP_QTY As String = "ComponentQty" -Private Const ORDER_HAS_COMP As String = "HasComponent" -Private Const ORDER_PARSE_ERR As String = "ParseError" - -' 部件库存字典键 -Private Const INV_CODE As String = "ComponentCode" -Private Const INV_DEMAND As String = "TotalDemand" -Private Const INV_STOCK As String = "AvailableStock" -Private Const INV_SHORTAGE As String = "IsShortage" - -' 统计信息结构 -Private Type Statistics - TotalOrders As Long ' 总订单数 - OrdersWithComponent As Long ' 包含部件的订单数 - OrdersSufficient As Long ' 库存充足订单数 - OrdersInsufficient As Long ' 库存不足订单数 - OrdersSkipped As Long ' 跳过订单数 -End Type - -'===================================================================== -' 主入口程序 -'===================================================================== -Public Sub CheckComponentInventory() - On Error GoTo ErrorHandler - - Dim startTime As Double - startTime = Timer - - ' 获取工作表对象 - Dim orderSheet As Worksheet - Dim inventorySheet As Worksheet - Dim bomSheet As Worksheet - - Set orderSheet = GetOrderSheet() - If orderSheet Is Nothing Then - MsgBox "未找到[产品订单]工作表!", vbExclamation - Exit Sub - End If - - Set inventorySheet = GetInventorySheet() - If inventorySheet Is Nothing Then - MsgBox "未找到[现存量]工作表!", vbExclamation - Exit Sub - End If - - Set bomSheet = GetBomSheet() - If bomSheet Is Nothing Then - MsgBox "未找到[平台配置清单]工作表!", vbExclamation - Exit Sub - End If - - ' 检查订单数据 - Dim lastRow As Long - lastRow = orderSheet.Cells(orderSheet.Rows.Count, 2).End(xlUp).Row - If lastRow < 2 Then - MsgBox "[产品订单]工作表没有数据!", vbExclamation - Exit Sub - End If - - ' 初始化BOM提取器 - Dim bomExtractor As BomExtractor - Set bomExtractor = New BomExtractor - bomExtractor.SetWorksheet bomSheet - - If Not bomExtractor.LoadBomData Then - MsgBox "加载BOM数据失败:" & bomExtractor.GetErrorSummary, vbCritical - Exit Sub - End If - - ' 读取库存数据到字典 - Dim inventoryData As Object - Set inventoryData = LoadInventoryData(inventorySheet) - - If inventoryData.Count = 0 Then - MsgBox "[现存量]工作表没有有效数据!", vbExclamation - Exit Sub - End If - - ' 读取订单数据 - Dim orders As Collection - Set orders = LoadOrderData(orderSheet) - - If orders.Count = 0 Then - MsgBox "没有有效的订单数据!", vbExclamation - Exit Sub - End If - - ' 解析所有订单的BOM - ParseAllOrdersBOM orders, bomExtractor - - ' 统计部件总需求 - Dim componentDemands As Object - Set componentDemands = CalculateComponentDemand(orders) - - If componentDemands.Count = 0 Then - MsgBox "没有订单包含'部件'类别物料,无需处理库存!", vbInformation - Exit Sub - End If - - ' 验证库存 - Dim validationWarnings As Collection - Set validationWarnings = ValidateInventory(componentDemands, inventoryData) - - ' 按订单顺序分配库存 - Dim stats As Statistics - AllocateInventory orders, componentDemands, orderSheet, stats - - ' 输出结果统计 - Dim elapsedTime As Double - elapsedTime = Timer - startTime - - Dim resultMsg As String - resultMsg = "部件库存核对完成!" & vbCrLf & vbCrLf - resultMsg = resultMsg & "处理订单数: " & stats.TotalOrders & vbCrLf - resultMsg = resultMsg & "包含部件订单: " & stats.OrdersWithComponent & vbCrLf - resultMsg = resultMsg & "库存充足订单: " & stats.OrdersSufficient & vbCrLf - resultMsg = resultMsg & "库存不足订单: " & stats.OrdersInsufficient & vbCrLf - If stats.OrdersSkipped > 0 Then - resultMsg = resultMsg & "跳过订单数: " & stats.OrdersSkipped & vbCrLf - End If - resultMsg = resultMsg & vbCrLf & "耗时: " & Format(elapsedTime, "0.00") & "秒" - - ' 显示警告信息（如果有） - If validationWarnings.Count > 0 Then - resultMsg = resultMsg & vbCrLf & vbCrLf & "警告信息:" & vbCrLf - resultMsg = resultMsg & JoinCollection(validationWarnings, vbCrLf) - End If - - MsgBox resultMsg, vbInformation - - Exit Sub - -ErrorHandler: - MsgBox "部件库存核对异常: " & Err.Description, vbCritical -End Sub - -'===================================================================== -' 函数: LoadOrderData -' 功能: 读取订单数据 -' 参数: ws - [产品订单]工作表 -' 返回: Collection - 每个元素是字典对象,包含订单信息 -'===================================================================== -Private Function LoadOrderData(ws As Worksheet) As Collection - Set LoadOrderData = New Collection - - Dim lastRow As Long - lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - - Dim i As Long - For i = 2 To lastRow - Dim model As String - Dim qty As Variant - - model = Trim(ws.Cells(i, 2).Value) ' B列: 产品型号 - qty = ws.Cells(i, 3).Value ' C列: 产品数量 - - ' 跳过空行 - If model <> "" Then - Dim order As Object - Set order = CreateObject("Scripting.Dictionary") - - order.Add ORDER_ROW, CLng(i) - order.Add ORDER_MODEL, CStr(model) - order.Add ORDER_QUANTITY, CDbl(IIf(IsNull(qty), 0, qty)) - order.Add ORDER_COMP_CODE, "" - order.Add ORDER_COMP_QTY, 0 - order.Add ORDER_HAS_COMP, False - order.Add ORDER_PARSE_ERR, "" - - LoadOrderData.Add order - End If - Next i -End Function - -'===================================================================== -' 函数: LoadInventoryData -' 功能: 读取库存数据 -' 参数: ws - [现存量]工作表 -' 返回: Dictionary(物料编码 -> 库存数量) -'===================================================================== -Private Function LoadInventoryData(ws As Worksheet) As Object - Set LoadInventoryData = CreateObject("Scripting.Dictionary") - - ' 从第4行开始读取(第3行是表头) - Dim lastRow As Long - lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - - Dim i As Long - For i = 4 To lastRow - Dim code As String - Dim qty As Variant - - code = Trim(ws.Cells(i, 2).Value) ' B列: 物料编码 - qty = ws.Cells(i, 10).Value ' J列: 结存主数量 - - If code <> "" And Not IsEmpty(qty) Then - If Not LoadInventoryData.Exists(code) Then - LoadInventoryData.Add code, CDbl(qty) - End If - End If - Next i -End Function - -'===================================================================== -' 过程: ParseAllOrdersBOM -' 功能: 解析所有订单的BOM -' 参数: orders - 订单集合(每个元素是字典) -' bomExtractor - BOM提取器 -'===================================================================== -Private Sub ParseAllOrdersBOM(orders As Collection, bomExtractor As BomExtractor) - Dim i As Long - For i = 1 To orders.Count - Dim order As Object - Set order = orders(i) - ParseOrderBOM order, bomExtractor - Next i -End Sub - -'===================================================================== -' 过程: ParseOrderBOM -' 功能: 解析单个订单的BOM,识别部件类别物料 -' 参数: orderInfo - 订单信息字典(ByRef) -' bomExtractor - BOM提取器 -'===================================================================== -Private Sub ParseOrderBOM(ByRef orderInfo As Object, bomExtractor As BomExtractor) - On Error Resume Next - - ' 解析型号 - Dim parser As ProductModelParser - Set parser = New ProductModelParser - - If Not parser.Parse(orderInfo(ORDER_MODEL)) Then - orderInfo(ORDER_PARSE_ERR) = "解析失败: " & parser.ErrorMessage - Exit Sub - End If - - ' 提取BOM - Dim matchedItems As Collection - Set matchedItems = bomExtractor.ExtractBom(parser.Conditions) - - ' 查找"部件"类别物料 - Dim item As BomItem - For Each item In matchedItems - If item.category = "部件" Then - orderInfo(ORDER_COMP_CODE) = item.Code66 - orderInfo(ORDER_COMP_QTY) = item.quantity - orderInfo(ORDER_HAS_COMP) = True - Exit For - End If - Next item -End Sub - -'===================================================================== -' 函数: CalculateComponentDemand -' 功能: 统计部件总需求 -' 参数: orders - 订单集合 -' 返回: Dictionary(部件编码 -> 库存信息字典) -'===================================================================== -Private Function CalculateComponentDemand(orders As Collection) As Object - Dim demands As Object - Set demands = CreateObject("Scripting.Dictionary") - - Dim i As Long - For i = 1 To orders.Count - Dim order As Object - Set order = orders(i) - - If order(ORDER_HAS_COMP) Then - Dim demand As Double - demand = order(ORDER_COMP_QTY) * order(ORDER_QUANTITY) - Dim compCode As String - compCode = order(ORDER_COMP_CODE) - - If demands.Exists(compCode) Then - Dim compInv As Object - Set compInv = demands(compCode) - compInv(INV_DEMAND) = compInv(INV_DEMAND) + demand - Else - Dim newComp As Object - Set newComp = CreateObject("Scripting.Dictionary") - newComp.Add INV_CODE, compCode - newComp.Add INV_DEMAND, demand - newComp.Add INV_STOCK, 0 - newComp.Add INV_SHORTAGE, False - demands.Add compCode, newComp - End If - End If - Next i - - Set CalculateComponentDemand = demands -End Function - -'===================================================================== -' 函数: ValidateInventory -' 功能: 验证库存数据 -' 参数: componentDemands - 部件需求字典 -' inventoryData - 库存数据字典 -' 返回: Collection - 警告信息集合(找不到的部件) -'===================================================================== -Private Function ValidateInventory(componentDemands As Object, _ - inventoryData As Object) As Collection - Set ValidateInventory = New Collection - - Dim code As Variant - For Each code In componentDemands.Keys - Dim compInv As Object - Set compInv = componentDemands(code) - - ' 检查库存中是否存在该部件 - If Not inventoryData.Exists(compInv(INV_CODE)) Then - ' 库存中找不到，设置库存为0，并添加警告 - compInv(INV_STOCK) = 0 - compInv(INV_SHORTAGE) = True - ValidateInventory.Add "部件 '" & compInv(INV_CODE) & "' 在[现存量]中未找到" - Else - ' 设置可用库存 - compInv(INV_STOCK) = inventoryData(compInv(INV_CODE)) - - ' 检查是否短缺 - If compInv(INV_DEMAND) > compInv(INV_STOCK) Then - compInv(INV_SHORTAGE) = True - End If - End If - Next code -End Function - -'===================================================================== -' 过程: AllocateInventory -' 功能: 按订单顺序分配库存并标记 -' 参数: orders - 订单集合 -' componentDemands - 部件需求字典 -' orderSheet - 订单工作表 -' stats - 统计信息(ByRef) -'===================================================================== -Private Sub AllocateInventory(orders As Collection, _ - componentDemands As Object, _ - orderSheet As Worksheet, _ - ByRef stats As Statistics) - - ' 初始化统计 - stats.TotalOrders = orders.Count - stats.OrdersWithComponent = 0 - stats.OrdersSufficient = 0 - stats.OrdersInsufficient = 0 - stats.OrdersSkipped = 0 - - Dim i As Long - For i = 1 To orders.Count - Dim order As Object - Set order = orders(i) - - ' 跳过解析失败的订单 - If order(ORDER_PARSE_ERR) <> "" Then - stats.OrdersSkipped = stats.OrdersSkipped + 1 - GoTo NextOrder - End If - - ' 跳过没有部件的订单 - If Not order(ORDER_HAS_COMP) Then - stats.OrdersSkipped = stats.OrdersSkipped + 1 - GoTo NextOrder - End If - - ' 跳过数量为0的订单 - If order(ORDER_QUANTITY) = 0 Then - stats.OrdersSkipped = stats.OrdersSkipped + 1 - GoTo NextOrder - End If - - stats.OrdersWithComponent = stats.OrdersWithComponent + 1 - - ' 获取部件库存信息 - Dim compInv As Object - Set compInv = componentDemands(order(ORDER_COMP_CODE)) - - ' 计算需求量 - Dim requiredQty As Double - requiredQty = order(ORDER_COMP_QTY) * order(ORDER_QUANTITY) - - ' 检查库存是否充足 - If compInv(INV_STOCK) >= requiredQty Then - ' 库存充足,扣减库存,保持原值 - compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty - stats.OrdersSufficient = stats.OrdersSufficient + 1 - Else - ' 库存不足,标记为"否" - orderSheet.Cells(order(ORDER_ROW), 5).Value = "否" - compInv(INV_STOCK) = compInv(INV_STOCK) - requiredQty - stats.OrdersInsufficient = stats.OrdersInsufficient + 1 - End If - -NextOrder: - Next i -End Sub - -'===================================================================== -' 函数: GetOrderSheet -' 功能: 获取[产品订单]工作表 -' 返回: Worksheet -'===================================================================== -Private Function GetOrderSheet() As Worksheet - On Error Resume Next - Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单") - On Error GoTo 0 -End Function - -'===================================================================== -' 函数: GetInventorySheet -' 功能: 获取[现存量]工作表 -' 返回: Worksheet -'===================================================================== -Private Function GetInventorySheet() As Worksheet - On Error Resume Next - Set GetInventorySheet = ThisWorkbook.Worksheets("现存量") - On Error GoTo 0 -End Function - -'===================================================================== -' 函数: GetBomSheet -' 功能: 获取[平台配置清单]工作表 -' 返回: Worksheet -'===================================================================== -Private Function GetBomSheet() As Worksheet - On Error Resume Next - Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单") - On Error GoTo 0 -End Function - -'===================================================================== -' 函数: JoinCollection -' 功能: 将集合内容连接为字符串 -' 参数: coll - 集合 -' separator - 分隔符 -' 返回: String -'===================================================================== -Private Function JoinCollection(coll As Collection, separator As String) As String - Dim result As String - result = "" - - Dim item As Variant - Dim isFirst As Boolean - isFirst = True - - For Each item In coll - If Not isFirst Then - result = result & separator - End If - result = result & CStr(item) - isFirst = False - Next item - - JoinCollection = result -End Function diff --git a/VBA/Modules/MainModule.bas b/VBA/Modules/MainModule.bas deleted file mode 100644 index babaee0..0000000 --- a/VBA/Modules/MainModule.bas +++ /dev/null @@ -1,430 +0,0 @@ -'===================================================================== -' 模块名: MainModule -' 功能: 主控模块,处理产品型号提取和BOM匹配的上层逻辑 -'===================================================================== - -Option Explicit - -'===================================================================== -' 常量定义 -'===================================================================== -' 提取条件配置(可灵活扩展) -Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能" - -'===================================================================== -' 过程: ProcessProductModels -' 功能: 批量处理产品型号并输出结果 -' 说明: 这是主入口程序 -'===================================================================== -Public Sub ProcessProductModels() - On Error GoTo ErrorHandler - - Dim startTime As Double - startTime = Timer - - ' 准备输入输出 - Dim inputSheet As Worksheet - Dim outputSheet As Worksheet - Dim bomSheet As Worksheet - - ' 获取工作表 - Set inputSheet = GetInputSheet() - If inputSheet Is Nothing Then - MsgBox "未找到输入工作表,请确保工作簿中有包含订单数据的工作表", vbCritical - Exit Sub - End If - - ' 获取BOM库工作表 - Set bomSheet = GetBomSheet() - If bomSheet Is Nothing Then - MsgBox "未找到'平台配置清单'工作表,请确保BOM数据存在", vbCritical - Exit Sub - End If - - ' 创建或获取输出工作表 - Set outputSheet = CreateOutputSheet() - - ' 初始化BOM提取器 - Dim BomExtractor As BomExtractor - Set BomExtractor = New BomExtractor - BomExtractor.SetWorksheet bomSheet - - If Not BomExtractor.LoadBomData Then - MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical - Exit Sub - End If - - ' 处理每个产品型号 - Dim lastRow As Long - lastRow = inputSheet.Cells(inputSheet.Rows.Count, 1).End(xlUp).row - - ' 写入输出表头 - WriteOutputHeader outputSheet - - ' 收集所有输出数据 - Dim outputData As collection - Set outputData = New collection - - Dim i As Long - Dim modelString As String - Dim processedCount As Long - - processedCount = 0 - - ' 假设产品型号在第1列,从第2行开始 - For i = 2 To lastRow - Dim orderNumber As String - orderNumber = Trim(inputSheet.Cells(i, 1).value) ' A列：生产订单号 - modelString = Trim(inputSheet.Cells(i, 2).value) - Dim componentPriority As String - componentPriority = Trim(inputSheet.Cells(i, 5).value) ' E列：部件优先 - - If modelString <> "" Then - ' 处理单个型号，收集数据 - ProcessSingleModel orderNumber, modelString, componentPriority, BomExtractor, outputData - processedCount = processedCount + 1 - End If - Next i - - ' 批量写入数据到工作表 - If outputData.Count > 0 Then - WriteBatchData outputSheet, outputData - End If - - ' 格式化输出表 - FormatOutputSheet outputSheet - - Dim elapsedTime As Double - elapsedTime = Timer - startTime - - MsgBox "处理完成!" & vbCrLf & _ - "处理型号数: " & processedCount & vbCrLf & _ - "用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation - - ' 激活输出表 - outputSheet.Activate - - Exit Sub - -ErrorHandler: - MsgBox "处理异常: " & Err.description, vbCritical -End Sub - -'===================================================================== -' 过程: ProcessSingleModel -' 功能: 处理单个产品型号，将数据添加到输出集合 -' 参数: orderNumber - 生产订单号 -' modelString - 产品型号字符串 -' componentPriority - 部件优先标志（"是"或"否"） -' bomExtractor - BOM提取器对象 -' outputData - 输出数据集合 -'===================================================================== -Private Sub ProcessSingleModel(orderNumber As String, _ - modelString As String, _ - componentPriority As String, _ - BomExtractor As BomExtractor, _ - outputData As collection) - On Error Resume Next - - ' 根据部件优先设置排除类别 - BomExtractor.ClearExcludeCategories - If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then - Dim excludeCats As New collection - excludeCats.Add "部件" - BomExtractor.SetExcludeCategories excludeCats - End If - - ' 解析产品型号 - Dim parser As ProductModelParser - Set parser = New ProductModelParser - - Dim extractNote As String - extractNote = "" - - If Not parser.Parse(modelString) Then - ' 解析失败 - extractNote = "解析失败: " & parser.ErrorMessage - outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, extractNote, Nothing) - Exit Sub - End If - - ' 提取BOM - Dim matchedItems As collection - Set matchedItems = BomExtractor.ExtractBom(parser.Conditions) - - ' 获取错误信息 - Dim bomErrors As String - bomErrors = BomExtractor.GetErrorSummary - If bomErrors <> "" Then - extractNote = bomErrors - End If - - ' 输出结果 - If matchedItems.Count = 0 Then - ' 没有匹配项 - If extractNote = "" Then - extractNote = "未匹配到任何物料" - End If - outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, extractNote, Nothing) - Else - ' 输出每个匹配的物料 - Dim item As BomItem - Dim isFirst As Boolean - isFirst = True - - For Each item In matchedItems - Dim itemNote As String - itemNote = extractNote - - ' 添加物料特定的错误 - If item.MatchError <> "" Then - If itemNote <> "" Then itemNote = itemNote & "; " - itemNote = itemNote & item.MatchError - End If - - If isFirst Then - outputData.Add CreateOutputRowArray(orderNumber, modelString, parser.Conditions, itemNote, item) - isFirst = False - Else - outputData.Add CreateOutputRowArray("", modelString, parser.Conditions, itemNote, item) - End If - Next item - End If -End Sub - -'===================================================================== -' 过程: WriteOutputHeader -' 功能: 写入输出表头 -' 参数: ws - 工作表对象 -'===================================================================== -Private Sub WriteOutputHeader(ws As Worksheet) - Dim col As Long - col = 1 - - ws.Cells(1, col).value = "生产订单号": col = col + 1 - ws.Cells(1, col).value = "产品型号": col = col + 1 - - ' 写入条件字段表头 - Dim Conditions() As String - Dim labels() As String - GetConditionConfig Conditions, labels - - Dim i As Long - For i = LBound(Conditions) To UBound(Conditions) - ws.Cells(1, col).value = labels(i) - col = col + 1 - Next i - - ' BOM字段表头 - ws.Cells(1, col).value = "行号": col = col + 1 - ws.Cells(1, col).value = "模块": col = col + 1 - ws.Cells(1, col).value = "代号": col = col + 1 - ws.Cells(1, col).value = "名称": col = col + 1 - ws.Cells(1, col).value = "数量": col = col + 1 - ws.Cells(1, col).value = "类别": col = col + 1 - ws.Cells(1, col).value = "66代码": col = col + 1 - ws.Cells(1, col).value = "提取备注": col = col + 1 -End Sub - -'===================================================================== -' 函数: CreateOutputRowArray -' 功能: 创建输出行数据的数组 -' 参数: orderNumber - 生产订单号 -' FullModel - 完整型号 -' Conditions - 条件字典 -' note - 备注 -' item - BOM项(可为Nothing) -' 返回: Variant() - 行数据数组 -'===================================================================== -Private Function CreateOutputRowArray(orderNumber As String, _ - FullModel As String, _ - Conditions As Object, _ - note As String, _ - item As BomItem) As Variant() - ' 获取条件配置 - Dim condNames() As String - Dim labels() As String - GetConditionConfig condNames, labels - - ' 计算总列数：2 + 条件数 + 8 - Dim totalCols As Long - totalCols = 2 + (UBound(condNames) - LBound(condNames) + 1) + 8 - - ' 创建数组 - ReDim rowData(1 To totalCols) As Variant - - Dim col As Long - col = 1 - - ' 生产订单号和产品型号 - rowData(col) = orderNumber: col = col + 1 - rowData(col) = FullModel: col = col + 1 - - ' 写入条件值 - Dim i As Long - For i = LBound(condNames) To UBound(condNames) - If Conditions.Exists(condNames(i)) Then - rowData(col) = Conditions(condNames(i)) - Else - rowData(col) = "" - End If - col = col + 1 - Next i - - ' 写入BOM数据 - If Not item Is Nothing Then - rowData(col) = item.RowNumber: col = col + 1 - rowData(col) = item.Module: col = col + 1 - rowData(col) = item.code: col = col + 1 - rowData(col) = item.Name: col = col + 1 - rowData(col) = item.quantity: col = col + 1 - rowData(col) = item.category: col = col + 1 - rowData(col) = item.Code66: col = col + 1 - Else - ' 跳过BOM字段 - col = col + 7 - End If - - ' 备注 - rowData(col) = note - - CreateOutputRowArray = rowData -End Function - -'===================================================================== -' 过程: WriteBatchData -' 功能: 批量写入数据到工作表 -' 参数: ws - 工作表对象 -' outputData - 输出数据集合 -'===================================================================== -Private Sub WriteBatchData(ws As Worksheet, outputData As collection) - ' 如果没有数据，直接返回 - If outputData.Count = 0 Then - Exit Sub - End If - - ' 获取第一行数据来确定列数 - Dim firstRow As Variant - firstRow = outputData(1) - - Dim rowCount As Long - Dim colCount As Long - rowCount = outputData.Count - colCount = UBound(firstRow) - LBound(firstRow) + 1 - - ' 创建二维数组 - Dim resultData() As Variant - ReDim resultData(1 To rowCount, 1 To colCount) - - ' 填充数据到二维数组 - Dim i As Long - Dim j As Long - Dim rowArray As Variant - - For i = 1 To rowCount - rowArray = outputData(i) - For j = 1 To colCount - resultData(i, j) = rowArray(j) - Next j - Next i - - ' 一次性写入工作表（从第2行开始） - ws.Range("A2").Resize(rowCount, colCount).value = resultData -End Sub - -'===================================================================== -' 过程: GetConditionConfig -' 功能: 获取条件配置 -' 参数: outNames - 输出条件名称数组 -' outLabels - 输出条件标签数组 -'===================================================================== -Private Sub GetConditionConfig(ByRef outNames() As String, ByRef outLabels() As String) - Dim configs() As String - configs = Split(CONDITION_CONFIG, "|") - - ReDim outNames(LBound(configs) To UBound(configs)) - ReDim outLabels(LBound(configs) To UBound(configs)) - - Dim i As Long - Dim parts() As String - - For i = LBound(configs) To UBound(configs) - parts = Split(configs(i), ",") - outNames(i) = Trim(parts(0)) - outLabels(i) = Trim(parts(1)) - Next i -End Sub - -'===================================================================== -' 函数: GetInputSheet -' 功能: 获取输入工作表 -' 返回: Worksheet - 输入工作表对象 -'===================================================================== -Private Function GetInputSheet() As Worksheet - ' 这里假设输入数据在当前活动工作表或名为"订单"的工作表 - On Error Resume Next - Set GetInputSheet = ThisWorkbook.Worksheets("产品订单") - If GetInputSheet Is Nothing Then - Set GetInputSheet = ActiveSheet - End If - On Error GoTo 0 -End Function - -'===================================================================== -' 函数: GetBomSheet -' 功能: 获取BOM工作表 -' 返回: Worksheet - BOM工作表对象 -'===================================================================== -Private Function GetBomSheet() As Worksheet - On Error Resume Next - Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单") - On Error GoTo 0 -End Function - -'===================================================================== -' 函数: CreateOutputSheet -' 功能: 创建或获取输出工作表 -' 返回: Worksheet - 输出工作表对象 -'===================================================================== -Private Function CreateOutputSheet() As Worksheet - Dim wsName As String - wsName = "BOM提取结果" - - On Error Resume Next - Set CreateOutputSheet = ThisWorkbook.Worksheets(wsName) - On Error GoTo 0 - - If CreateOutputSheet Is Nothing Then - Set CreateOutputSheet = ThisWorkbook.Worksheets.Add - CreateOutputSheet.Name = wsName - Else - ' 清空现有数据 - CreateOutputSheet.Cells.Clear - End If -End Function - -'===================================================================== -' 过程: FormatOutputSheet -' 功能: 格式化输出工作表 -' 参数: ws - 工作表对象 -'===================================================================== -Private Sub FormatOutputSheet(ws As Worksheet) - On Error Resume Next - - ' 设置表头格式 - With ws.Rows(1) - .Font.Bold = True - .Interior.Color = RGB(217, 217, 217) - .HorizontalAlignment = xlCenter - End With - -' ' 自动调整列宽 -' ws.Columns.AutoFit -' -' ' 冻结首行 -' ws.Rows(2).Select -' 'ActiveWindow.FreezePanes = True -' ws.Cells(1, 1).Select - - On Error GoTo 0 -End Sub \ No newline at end of file diff --git a/VBA/Modules/TestModule.bas b/VBA/Modules/TestModule.bas deleted file mode 100644 index 4640bca..0000000 --- a/VBA/Modules/TestModule.bas +++ /dev/null @@ -1,336 +0,0 @@ -'===================================================================== -' 模块名: TestModule -' 功能: 单元测试模块 -'===================================================================== - -Option Explicit - -'===================================================================== -' 过程: RunAllTests -' 功能: 运行所有测试 -'===================================================================== -Public Sub RunAllTests() - Debug.Print "==========================================" - Debug.Print "开始运行所有测试" - Debug.Print "时间: " & Now - Debug.Print "==========================================" - Debug.Print "" - - ' 运行各个测试 - TestProductModelParser - TestConditionEvaluator - TestBomExtractor - - Debug.Print "" - Debug.Print "==========================================" - Debug.Print "所有测试完成" - Debug.Print "==========================================" - - MsgBox "所有测试完成,请查看立即窗口查看结果", vbInformation -End Sub - -'===================================================================== -' 过程: TestProductModelParser -' 功能: 测试产品型号解析器 -'===================================================================== -Public Sub TestProductModelParser() - Debug.Print ">>> 测试 ProductModelParser" - Debug.Print "" - - Dim parser As ProductModelParser - Set parser = New ProductModelParser - - ' 测试用例1: 正常型号 - Debug.Print "测试用例1: 正常型号" - Dim testModel1 As String - testModel1 = "YTHN-100.A0.531.M203.M06.Y3|BP-088.2312.M06.0A3" - - If parser.Parse(testModel1) Then - Debug.Print " 解析成功" - Debug.Print " 表头型号: " & parser.HeaderModel - Debug.Print " 条件:" - Debug.Print " azxs = " & parser.GetConditionValue("azxs") - Debug.Print " bkxs = " & parser.GetConditionValue("bkxs") - Debug.Print " gclj = " & parser.GetConditionValue("gclj") - Debug.Print " jycz = " & parser.GetConditionValue("jycz") - Debug.Print " lcfw = " & parser.GetConditionValue("lcfw") - - ' 验证结果 - AssertEquals "azxs", "A0", parser.GetConditionValue("azxs") - AssertEquals "bkxs", "531", parser.GetConditionValue("bkxs") - AssertEquals "gclj", "M20", parser.GetConditionValue("gclj") - AssertEquals "jycz", "3", parser.GetConditionValue("jycz") - AssertEquals "lcfw", "M06", parser.GetConditionValue("lcfw") - Else - Debug.Print " 解析失败: " & parser.ErrorMessage - End If - Debug.Print "" - - ' 测试用例2: 不同材质代码 - Debug.Print "测试用例2: 不同材质代码" - Dim testModel2 As String - testModel2 = "YTHN-100.BZ.531.M201.M09.Y3|BP-088.2312.M37.0A3" - - If parser.Parse(testModel2) Then - Debug.Print " 解析成功" - Debug.Print " gclj = " & parser.GetConditionValue("gclj") - Debug.Print " jycz = " & parser.GetConditionValue("jycz") - - AssertEquals "gclj", "M20", parser.GetConditionValue("gclj") - AssertEquals "jycz", "1", parser.GetConditionValue("jycz") - Else - Debug.Print " 解析失败: " & parser.ErrorMessage - End If - Debug.Print "" - - ' 测试用例3: 带附件的型号 - Debug.Print "测试用例3: 带附件的型号" - Dim testModel3 As String - testModel3 = "YTHN-100.A0.531.G123.M04.Y3|BP-088.2312.B09.0A3" - - If parser.Parse(testModel3) Then - Debug.Print " 解析成功" - Debug.Print " gclj = " & parser.GetConditionValue("gclj") - Debug.Print " jycz = " & parser.GetConditionValue("jycz") - - AssertEquals "gclj", "G12", parser.GetConditionValue("gclj") - AssertEquals "jycz", "3", parser.GetConditionValue("jycz") - Else - Debug.Print " 解析失败: " & parser.ErrorMessage - End If - Debug.Print "" - - Debug.Print "<<< ProductModelParser 测试完成" - Debug.Print "" -End Sub - -'===================================================================== -' 过程: TestConditionEvaluator -' 功能: 测试条件评估器 -'===================================================================== -Public Sub TestConditionEvaluator() - Debug.Print ">>> 测试 ConditionEvaluator" - Debug.Print "" - - Dim evaluator As ConditionEvaluator - Set evaluator = New ConditionEvaluator - - ' 创建测试条件字典 - Dim Conditions As Object - Set Conditions = CreateObject("Scripting.Dictionary") - Conditions.Add "azxs", "A0" - Conditions.Add "bkxs", "531" - Conditions.Add "gclj", "M20" - Conditions.Add "jycz", "3" - Conditions.Add "lcfw", "M06" - - ' 测试用例1: 简单等式 - Debug.Print "测试用例1: 简单等式" - Dim expr1 As String - expr1 = "azxs=A0" - Debug.Print " 表达式: " & expr1 - Debug.Print " 结果: " & evaluator.Evaluate(expr1, Conditions) - AssertTrue "简单等式", evaluator.Evaluate(expr1, Conditions) - Debug.Print "" - - ' 测试用例2: AND运算 - Debug.Print "测试用例2: AND运算" - Dim expr2 As String - expr2 = "azxs=A0 AND bkxs=531" - Debug.Print " 表达式: " & expr2 - Debug.Print " 结果: " & evaluator.Evaluate(expr2, Conditions) - AssertTrue "AND运算", evaluator.Evaluate(expr2, Conditions) - Debug.Print "" - - ' 测试用例3: OR运算 - Debug.Print "测试用例3: OR运算" - Dim expr3 As String - expr3 = "azxs=AT OR azxs=A0" - Debug.Print " 表达式: " & expr3 - Debug.Print " 结果: " & evaluator.Evaluate(expr3, Conditions) - AssertTrue "OR运算", evaluator.Evaluate(expr3, Conditions) - Debug.Print "" - - ' 测试用例4: !=运算 - Debug.Print "测试用例4: !=运算" - Dim expr4 As String - expr4 = "azxs!=AH" - Debug.Print " 表达式: " & expr4 - Debug.Print " 结果: " & evaluator.Evaluate(expr4, Conditions) - AssertTrue "!=运算", evaluator.Evaluate(expr4, Conditions) - Debug.Print "" - - ' 测试用例5: 复杂嵌套 - Debug.Print "测试用例5: 复杂嵌套" - Dim expr5 As String - expr5 = "(azxs=A0 OR azxs=AT) AND (bkxs=531 OR bkxs=541)" - Debug.Print " 表达式: " & expr5 - Debug.Print " 结果: " & evaluator.Evaluate(expr5, Conditions) - AssertTrue "复杂嵌套", evaluator.Evaluate(expr5, Conditions) - Debug.Print "" - - ' 测试用例6: 不存在的变量(!=情况) - Debug.Print "测试用例6: 不存在的变量(!=情况)" - Dim expr6 As String - expr6 = "tsyq!=SCRJ" - Debug.Print " 表达式: " & expr6 - Debug.Print " 结果: " & evaluator.Evaluate(expr6, Conditions) - AssertTrue "不存在的变量!=", evaluator.Evaluate(expr6, Conditions) - Debug.Print "" - - ' 测试用例7: 实际BOM条件 - Debug.Print "测试用例7: 实际BOM条件" - Dim expr7 As String - expr7 = "gclj=M20 AND jycz=1 AND lcfw=M01 AND (azxs=A0 OR azxs=AT OR azxs=AH)" - Debug.Print " 表达式: " & expr7 - Debug.Print " 结果: " & evaluator.Evaluate(expr7, Conditions) - ' 这个应该是False,因为jycz=3,不是1 - AssertFalse "实际BOM条件(应该False)", evaluator.Evaluate(expr7, Conditions) - Debug.Print "" - - Debug.Print "<<< ConditionEvaluator 测试完成" - Debug.Print "" -End Sub - -'===================================================================== -' 过程: TestBomExtractor -' 功能: 测试BOM提取器(需要实际的工作表数据) -'===================================================================== -Public Sub TestBomExtractor() - Debug.Print ">>> 测试 BomExtractor" - Debug.Print "" - - On Error Resume Next - Dim bomSheet As Worksheet - Set bomSheet = ThisWorkbook.Worksheets("平台配置清单") - - If bomSheet Is Nothing Then - Debug.Print "警告: 未找到'平台配置清单'工作表,跳过BomExtractor测试" - Debug.Print "" - Exit Sub - End If - On Error GoTo 0 - - Dim extractor As BomExtractor - Set extractor = New BomExtractor - extractor.SetWorksheet bomSheet - - If Not extractor.LoadBomData Then - Debug.Print "加载BOM数据失败: " & extractor.GetErrorSummary - Debug.Print "" - Exit Sub - End If - - Debug.Print "BOM数据加载成功" - Debug.Print "" - - ' 测试用例: 提取BOM - Debug.Print "测试用例: 提取BOM" - Dim testConditions As Object - Set testConditions = CreateObject("Scripting.Dictionary") - testConditions.Add "azxs", "A0" - testConditions.Add "bkxs", "531" - testConditions.Add "gclj", "M20" - testConditions.Add "jycz", "1" - testConditions.Add "lcfw", "M01" - - Dim matchedItems As collection - Set matchedItems = extractor.ExtractBom(testConditions) - - Debug.Print " 匹配到 " & matchedItems.Count & " 个物料" - - If matchedItems.Count > 0 Then - Debug.Print " 匹配的物料:" - Dim item As BomItem - Dim i As Long - i = 1 - For Each item In matchedItems - Debug.Print " " & i & ". " & item.ToString - i = i + 1 - Next item - End If - - Dim errors As String - errors = extractor.GetErrorSummary - If errors <> "" Then - Debug.Print " 错误信息: " & errors - End If - - Debug.Print "" - Debug.Print "<<< BomExtractor 测试完成" - Debug.Print "" -End Sub - -'===================================================================== -' 辅助测试函数 -'===================================================================== - -Private Sub AssertEquals(testName As String, expected As String, actual As String) - If expected = actual Then - Debug.Print " PASS: " & testName - Else - Debug.Print " FAIL: " & testName & " (期望:" & expected & ", 实际:" & actual & ")" - End If -End Sub - -Private Sub AssertTrue(testName As String, value As Boolean) - If value Then - Debug.Print " PASS: " & testName - Else - Debug.Print " FAIL: " & testName & " (期望:True, 实际:False)" - End If -End Sub - -Private Sub AssertFalse(testName As String, value As Boolean) - If Not value Then - Debug.Print " PASS: " & testName - Else - Debug.Print " FAIL: " & testName & " (期望:False, 实际:True)" - End If -End Sub - -'===================================================================== -' 过程: TestWithProvidedModels -' 功能: 使用提供的测试型号进行测试 -'===================================================================== -Public Sub TestWithProvidedModels() - Debug.Print "==========================================" - Debug.Print "使用提供的测试型号进行测试" - Debug.Print "==========================================" - Debug.Print "" - - Dim testModels() As String - testModels = Split( _ - "YTHN-100.A0.531.G123.M04.Y3|BP-088.2312.B09.0A3," & _ - "YTHN-100.BZ.531.M201.M09.Y3|BP-088.2312.M37.0A3," & _ - "YTHN-100.BZ.531.M201.M08.Y3|BP-088.2312.M08.0A3," & _ - "YTHN-100.A0.531.M201.M08.Y3|BP-088.2312.M08.0B3," & _ - "YTHN-100.A0.531.M203.M06.Y3|BP-088.2312.M06.0A3|LSG-1.14x2.M20F.M20.3^HDJ.M20F.BW.14×2×60.3^TSFJ^WHP.70X20X1.3," & _ - "YTHN-100.A0.531.M203.P21.Y3|BP-088.2312.M39.0A3|HDJ.M20F.BW.14×2×60.3^LSG-1.14x2.M20F.M20.3^TSFJ^WHP.70X20X1.3," & _ - "YTHN-100.A0.531.M201.M03.N1.Y3|BP-088.2312.M31.0A4," & _ - "YTHN-100.A0.531.M201.M04.Y3|BP-088.2312.M32.0A3," & _ - "YTHN-100.A0.531.Z121.M07.Y3|BP-088.2312.M07.0A3," & _ - "YTHN-100.A0.531.Z121.M08.Y3|BP-088.2312.M08.0A3", _ - ",") - - Dim parser As ProductModelParser - Set parser = New ProductModelParser - - Dim i As Long - For i = LBound(testModels) To UBound(testModels) - Debug.Print "型号 " & (i + 1) & ": " & testModels(i) - - If parser.Parse(testModels(i)) Then - Debug.Print " 解析成功" - Debug.Print " 表头: " & parser.HeaderModel - Debug.Print " 条件: " & parser.GetAllConditions - Else - Debug.Print " 解析失败: " & parser.ErrorMessage - End If - Debug.Print "" - Next i - - Debug.Print "==========================================" - Debug.Print "测试完成" - Debug.Print "==========================================" -End Sub \ No newline at end of file diff --git a/VBA/vba_metadata.json b/VBA/vba_metadata.json deleted file mode 100644 index ec9cb12..0000000 --- a/VBA/vba_metadata.json +++ /dev/null @@ -1,53 +0,0 @@ -{ - "source_file": "C:\\Users\\Administrator\\Desktop\\新BOM\\AutoBOM\\YTHN-100.xlsm", - "modules": { - "Sheet9.cls": { - "name": "Sheet9", - "type": "DocumentModules", - "attributes": {}, - "file": "DocumentModules\\Sheet9.cls" - }, - "MainModule.bas": { - "name": "MainModule", - "type": "Modules", - "attributes": {}, - "file": "Modules\\MainModule.bas" - }, - "TestModule.bas": { - "name": "TestModule", - "type": "Modules", - "attributes": {}, - "file": "Modules\\TestModule.bas" - }, - "BomExtractor.cls": { - "name": "BomExtractor", - "type": "ClassModules", - "attributes": {}, - "file": "ClassModules\\BomExtractor.cls" - }, - "BomItem.cls": { - "name": "BomItem", - "type": "ClassModules", - "attributes": {}, - "file": "ClassModules\\BomItem.cls" - }, - "ConditionEvaluator.cls": { - "name": "ConditionEvaluator", - "type": "ClassModules", - "attributes": {}, - "file": "ClassModules\\ConditionEvaluator.cls" - }, - "ProductModelParser.cls": { - "name": "ProductModelParser", - "type": "ClassModules", - "attributes": {}, - "file": "ClassModules\\ProductModelParser.cls" - }, - "BIPUploadModule.bas": { - "name": "BIPUploadModule", - "type": "Modules", - "attributes": {}, - "file": "Modules\\BIPUploadModule.bas" - } - } -} \ No newline at end of file