refactor: remove debug output and update order logic
- Commented out verbose Debug.Print statements in `GetMaterialsByModel` and `FilterCategoryWithSubcategories` to reduce console noise.
- Added validation checks to ensure required worksheets ('平台配置清单', '产品订单') exist before loading data.
- Refactored order processing logic to aggregate results into a Collection for structured output generation, including headers.
This commit is contained in:
Misaka_Company
@@ -424,7 +424,7 @@ Public Function GetMaterialsByModel(modelStr As String, _
|
||||
' ========================================
|
||||
Dim parser As New clsModelParser
|
||||
If Not parser.ParseModel(modelStr) Then
|
||||
Debug.Print "型号解析失败: " & parser.ErrorMessage
|
||||
'Debug.Print "型号解析失败: " & parser.ErrorMessage
|
||||
Set GetMaterialsByModel = result
|
||||
Exit Function
|
||||
End If
|
||||
@@ -434,13 +434,13 @@ Public Function GetMaterialsByModel(modelStr As String, _
|
||||
Set conditions = extractor.ExtractConditions(parser)
|
||||
|
||||
' 调试输出
|
||||
Debug.Print "【型号】: " & modelStr
|
||||
Debug.Print "【提取的条件】:"
|
||||
'Debug.Print "【型号】: " & modelStr
|
||||
'Debug.Print "【提取的条件】:"
|
||||
Dim key As Variant
|
||||
For Each key In conditions.Keys
|
||||
Debug.Print " " & key & " = " & conditions(key)
|
||||
'Debug.Print " " & key & " = " & conditions(key)
|
||||
Next key
|
||||
Debug.Print ""
|
||||
'Debug.Print ""
|
||||
|
||||
' ========================================
|
||||
' 第2步: 按类别筛选物料（根据参数决定是否自动降级到子类别）
|
||||
@@ -454,11 +454,11 @@ Public Function GetMaterialsByModel(modelStr As String, _
|
||||
totalMatchCount = 0
|
||||
|
||||
If autoFallback Then
|
||||
Debug.Print "【降级模式】启用自动降级到子类别"
|
||||
'Debug.Print "【降级模式】启用自动降级到子类别"
|
||||
Else
|
||||
Debug.Print "【降级模式】禁用自动降级，仅查找当前类别"
|
||||
'Debug.Print "【降级模式】禁用自动降级，仅查找当前类别"
|
||||
End If
|
||||
Debug.Print ""
|
||||
'Debug.Print ""
|
||||
|
||||
If categoryName <> "" Then
|
||||
' ========================================
|
||||
@@ -496,8 +496,8 @@ Public Function GetMaterialsByModel(modelStr As String, _
|
||||
Next j
|
||||
End If
|
||||
|
||||
Debug.Print "共匹配 " & totalMatchCount & " 个物料"
|
||||
Debug.Print String(60, "=")
|
||||
'Debug.Print "共匹配 " & totalMatchCount & " 个物料"
|
||||
'Debug.Print String(60, "=")
|
||||
|
||||
Set GetMaterialsByModel = result
|
||||
End Function
|
||||
@@ -557,7 +557,7 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _
|
||||
matchCount = matchCount + 1
|
||||
|
||||
' 调试输出
|
||||
Debug.Print "【匹配】" & cat.categoryName & " > " & _
|
||||
'Debug.Print "【匹配】" & cat.categoryName & " > " & _
|
||||
mat.code & " - " & mat.Name & _
|
||||
" | 条件: " & IIf(mat.Condition = "", "(无)", mat.Condition)
|
||||
End If
|
||||
@@ -567,7 +567,7 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _
|
||||
' 第二阶段: 如果当前类别无匹配且允许降级，检查子类别
|
||||
' ========================================
|
||||
If matchCount = 0 And cat.HasSubCategories And autoFallback Then
|
||||
Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..."
|
||||
'Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..."
|
||||
|
||||
' 递归处理所有子类别
|
||||
Dim subCat As clsCategory
|
||||
@@ -586,9 +586,9 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _
|
||||
Next k
|
||||
Next j
|
||||
ElseIf matchCount = 0 And cat.HasSubCategories And Not autoFallback Then
|
||||
Debug.Print "【跳过】类别 """ & cat.categoryName & """ 无匹配物料，但降级已禁用，不查找子类别"
|
||||
'Debug.Print "【跳过】类别 """ & cat.categoryName & """ 无匹配物料，但降级已禁用，不查找子类别"
|
||||
ElseIf matchCount > 0 Then
|
||||
Debug.Print "【成功】类别 """ & cat.categoryName & """ 匹配 " & matchCount & " 个物料"
|
||||
'Debug.Print "【成功】类别 """ & cat.categoryName & """ 匹配 " & matchCount & " 个物料"
|
||||
End If
|
||||
|
||||
Set FilterCategoryWithSubcategories = result
|
||||
@@ -712,7 +712,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
|
||||
Dim allMaterials As New collection
|
||||
Dim allMissingCats As New collection ' 用于存储所有缺失的类别
|
||||
Dim isComplete As Boolean
|
||||
|
||||
|
||||
' 解析型号并提取条件
|
||||
Dim parser As New clsModelParser
|
||||
If Not parser.ParseModel(modelStr) Then
|
||||
@@ -724,26 +724,26 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
|
||||
Set GetValidMaterialsByModel = result
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
Dim extractor As New clsConditionExtractor
|
||||
Dim conditions As Object
|
||||
Set conditions = extractor.ExtractConditions(parser)
|
||||
|
||||
|
||||
' 条件匹配器
|
||||
Dim matcher As New clsConditionMatcher
|
||||
|
||||
|
||||
' 遍历所有根类别,检查完整性
|
||||
isComplete = True
|
||||
|
||||
|
||||
Dim rootCat As clsCategory
|
||||
Dim i As Long
|
||||
For i = 1 To rootCategories.count
|
||||
For i = 1 To rootCategories.Count
|
||||
Set rootCat = rootCategories(i)
|
||||
|
||||
|
||||
' 检查该类别及其子类别的完整性
|
||||
Dim catResult As Object
|
||||
Set catResult = CheckCategoryCompleteness(rootCat, matcher, conditions)
|
||||
|
||||
|
||||
' 1. 合并匹配到的物料
|
||||
Dim mat As clsMaterialItem
|
||||
Dim matCollection As collection
|
||||
@@ -751,7 +751,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
|
||||
For Each mat In matCollection
|
||||
allMaterials.Add mat
|
||||
Next mat
|
||||
|
||||
|
||||
' 2. 合并缺失的类别 (新增)
|
||||
Dim missingCollection As collection
|
||||
Set missingCollection = catResult("Missing")
|
||||
@@ -759,18 +759,18 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
|
||||
For Each missingCatName In missingCollection
|
||||
allMissingCats.Add missingCatName
|
||||
Next missingCatName
|
||||
|
||||
|
||||
' 3. 检查完整性状态
|
||||
If Not catResult("IsComplete") Then
|
||||
isComplete = False
|
||||
End If
|
||||
Next i
|
||||
|
||||
|
||||
' 返回结果
|
||||
result.Add allMaterials, "Materials"
|
||||
result.Add isComplete, "IsComplete"
|
||||
result.Add allMissingCats, "MissingCategories" ' 新增返回项
|
||||
|
||||
|
||||
Set GetValidMaterialsByModel = result
|
||||
End Function
|
||||
|
||||
@@ -803,25 +803,25 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
|
||||
conditions As Object) As Object
|
||||
Dim result As Object
|
||||
Set result = CreateObject("Scripting.Dictionary")
|
||||
|
||||
|
||||
Dim materials As New collection
|
||||
Dim missingCats As New collection ' 本层级及子层级缺失的类别
|
||||
Dim isComplete As Boolean
|
||||
|
||||
|
||||
' 首先在当前类别查找匹配的物料
|
||||
Dim mat As clsMaterialItem
|
||||
Dim matchCount As Long
|
||||
matchCount = 0
|
||||
|
||||
|
||||
Dim i As Long
|
||||
For i = 1 To cat.materials.count
|
||||
For i = 1 To cat.materials.Count
|
||||
Set mat = cat.materials(i)
|
||||
If matcher.IsMatch(mat.Condition, conditions) Then
|
||||
materials.Add mat
|
||||
matchCount = matchCount + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
|
||||
' 判断完整性
|
||||
If Not cat.HasSubCategories Then
|
||||
' ========================================
|
||||
@@ -847,28 +847,28 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
|
||||
' 不需要检查子类别了，missingCats 保持为空
|
||||
ElseIf matchCount = 0 Then
|
||||
' 父类别无匹配物料, 必须降级检查所有子类别
|
||||
|
||||
|
||||
' 清空当前物料集合(确保没东西), 准备收集子类别结果
|
||||
Set materials = New collection
|
||||
isComplete = True ' 先假设完整, 若任一子类别不完整则置错
|
||||
|
||||
|
||||
Dim subCat As clsCategory
|
||||
Dim j As Long
|
||||
For j = 1 To cat.SubCategories.count
|
||||
For j = 1 To cat.SubCategories.Count
|
||||
Set subCat = cat.SubCategories(j)
|
||||
|
||||
|
||||
' 递归检查子类别
|
||||
Dim subResult As Object
|
||||
Set subResult = CheckCategoryCompleteness(subCat, matcher, conditions)
|
||||
|
||||
|
||||
' a) 合并子类别物料
|
||||
Dim subMaterials As collection
|
||||
Set subMaterials = subResult("Materials")
|
||||
Dim k As Long
|
||||
For k = 1 To subMaterials.count
|
||||
For k = 1 To subMaterials.Count
|
||||
materials.Add subMaterials(k)
|
||||
Next k
|
||||
|
||||
|
||||
' b) 合并子类别缺失列表 (关键步骤)
|
||||
Dim subMissing As collection
|
||||
Set subMissing = subResult("Missing")
|
||||
@@ -876,7 +876,7 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
|
||||
For Each item In subMissing
|
||||
missingCats.Add item
|
||||
Next item
|
||||
|
||||
|
||||
' c) 更新完整性状态
|
||||
If Not subResult("IsComplete") Then
|
||||
isComplete = False
|
||||
@@ -887,10 +887,10 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
|
||||
isComplete = False
|
||||
End If
|
||||
End If
|
||||
|
||||
|
||||
' 封装返回结果
|
||||
Set result("Materials") = materials
|
||||
result("IsComplete") = isComplete
|
||||
Set result("Missing") = missingCats
|
||||
Set CheckCategoryCompleteness = result
|
||||
End Function
|
||||
End Function
|
||||
34
VBA/ClassModules/clsMaterialWithFlag.cls
Normal file
34
VBA/ClassModules/clsMaterialWithFlag.cls
Normal file
@@ -0,0 +1,34 @@
|
||||
' ========================================
|
||||
' 类模块: clsMaterialWithFlag
|
||||
' 用途: 包装物料对象及其匹配状态标志
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
Private mMaterial As clsMaterialItem ' 物料对象
|
||||
Private mIsComplete As Boolean ' 是否完整匹配
|
||||
|
||||
' ========================================
|
||||
' 属性: Material
|
||||
' 说明: 获取或设置物料对象
|
||||
' ========================================
|
||||
Public Property Get Material() As clsMaterialItem
|
||||
Set Material = mMaterial
|
||||
End Property
|
||||
|
||||
Public Property Set Material(ByVal value As clsMaterialItem)
|
||||
Set mMaterial = value
|
||||
End Property
|
||||
|
||||
' ========================================
|
||||
' 属性: IsComplete
|
||||
' 说明: 获取或设置是否完整匹配
|
||||
' True: 该物料属于完整的物料清单
|
||||
' False: 该物料属于不完整的物料清单（某些类别缺失物料）
|
||||
' ========================================
|
||||
Public Property Get isComplete() As Boolean
|
||||
isComplete = mIsComplete
|
||||
End Property
|
||||
|
||||
Public Property Let isComplete(ByVal value As Boolean)
|
||||
mIsComplete = value
|
||||
End Property
|
||||
@@ -87,7 +87,7 @@ Sub Example1_GeneratePickingListByModel()
|
||||
wsPickList.Cells(row, 3).value = mat.Name
|
||||
wsPickList.Cells(row, 4).value = mat.Quantity
|
||||
wsPickList.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition)
|
||||
wsPickList.Cells(row, 6).value = "✓"
|
||||
wsPickList.Cells(row, 6).value = "??"
|
||||
row = row + 1
|
||||
Next j
|
||||
Next i
|
||||
@@ -486,9 +486,9 @@ Sub Example6_CompareAutoFallback()
|
||||
wsCompare.Cells(row, 1).value = "说明:"
|
||||
wsCompare.Cells(row, 1).Font.Bold = True
|
||||
row = row + 1
|
||||
wsCompare.Cells(row, 1).value = "• autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找"
|
||||
wsCompare.Cells(row, 1).value = "?? autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找"
|
||||
row = row + 1
|
||||
wsCompare.Cells(row, 1).value = "• autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合"
|
||||
wsCompare.Cells(row, 1).value = "?? autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合"
|
||||
|
||||
' 格式化
|
||||
wsCompare.Columns("A:E").AutoFit
|
||||
@@ -554,7 +554,7 @@ Sub Example7_TestGetValidMaterialsByModel()
|
||||
Dim materials As collection
|
||||
Dim missingCats As collection
|
||||
Dim isComplete As Boolean
|
||||
|
||||
|
||||
Set materials = result("Materials")
|
||||
Set missingCats = result("MissingCategories") ' 直接获取缺失列表
|
||||
isComplete = result("IsComplete")
|
||||
@@ -570,7 +570,7 @@ Sub Example7_TestGetValidMaterialsByModel()
|
||||
row = row + 1
|
||||
|
||||
wsTest.Cells(row, 1).value = "完整性:"
|
||||
wsTest.Cells(row, 2).value = IIf(isComplete, "✓ 完整", "✕ 不完整")
|
||||
wsTest.Cells(row, 2).value = IIf(isComplete, "?? 完整", "?? 不完整")
|
||||
If isComplete Then
|
||||
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
|
||||
Else
|
||||
@@ -578,12 +578,12 @@ Sub Example7_TestGetValidMaterialsByModel()
|
||||
End If
|
||||
wsTest.Cells(row, 2).Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
|
||||
' 3. 打印匹配到的物料
|
||||
wsTest.Cells(row, 1).value = "【已匹配物料】"
|
||||
wsTest.Cells(row, 1).Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
|
||||
wsTest.Cells(row, 1).value = "类别"
|
||||
wsTest.Cells(row, 2).value = "代号"
|
||||
wsTest.Cells(row, 3).value = "名称"
|
||||
@@ -591,9 +591,9 @@ Sub Example7_TestGetValidMaterialsByModel()
|
||||
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Font.Bold = True
|
||||
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Interior.Color = RGB(220, 220, 220)
|
||||
row = row + 1
|
||||
|
||||
|
||||
Dim mat As clsMaterialItem
|
||||
If materials.count > 0 Then
|
||||
If materials.Count > 0 Then
|
||||
For Each mat In materials
|
||||
wsTest.Cells(row, 1).value = mat.Category
|
||||
wsTest.Cells(row, 2).value = mat.code
|
||||
@@ -605,18 +605,18 @@ Sub Example7_TestGetValidMaterialsByModel()
|
||||
wsTest.Cells(row, 1).value = "(无)"
|
||||
row = row + 1
|
||||
End If
|
||||
|
||||
|
||||
' 4. 打印缺失的类别 (新增核心功能)
|
||||
If missingCats.count > 0 Then
|
||||
If missingCats.Count > 0 Then
|
||||
row = row + 1
|
||||
wsTest.Cells(row, 1).value = "【缺失类别】"
|
||||
wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
|
||||
wsTest.Cells(row, 1).Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
|
||||
Dim catName As Variant
|
||||
For Each catName In missingCats
|
||||
wsTest.Cells(row, 1).value = "❌ " & catName
|
||||
wsTest.Cells(row, 1).value = "?? " & catName
|
||||
wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
|
||||
wsTest.Cells(row, 2).value = "未找到匹配物料"
|
||||
row = row + 1
|
||||
@@ -631,4 +631,360 @@ Sub Example7_TestGetValidMaterialsByModel()
|
||||
|
||||
wsTest.Columns("A:D").AutoFit
|
||||
MsgBox "测试完成！", vbInformation
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例8: 批量处理产品订单，生成物料清单
|
||||
' ========================================
|
||||
Sub Example8_BatchProcessOrders()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsConfig As Worksheet
|
||||
Dim wsPlatform As Worksheet
|
||||
Dim wsOrders As Worksheet
|
||||
Dim wsOutput As Worksheet
|
||||
|
||||
' 加载配置
|
||||
On Error Resume Next
|
||||
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
|
||||
|
||||
If wsConfig Is Nothing Then
|
||||
MsgBox "找不到工作表: 领料配置", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
If wsPlatform Is Nothing Then
|
||||
MsgBox "找不到工作表: 平台配置清单", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
If wsOrders Is Nothing Then
|
||||
MsgBox "找不到工作表: 产品订单", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
On Error GoTo 0
|
||||
|
||||
bomMgr.LoadData wsConfig, wsPlatform
|
||||
|
||||
' 读取订单数据
|
||||
Dim lastRow As Long
|
||||
lastRow = wsOrders.Cells(wsOrders.Rows.Count, "A").End(xlUp).row
|
||||
|
||||
If lastRow < 2 Then
|
||||
MsgBox "产品订单工作表没有数据！" & vbCrLf & _
|
||||
"请确保第一行是表头，从第二行开始是数据。", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 使用 Collection 收集所有输出行
|
||||
Dim outputData As collection
|
||||
Set outputData = New collection
|
||||
|
||||
' 添加表头
|
||||
outputData.Add Array("来源单号", "产品型号", "物料代码", "物料名称", "数量", "选择条件", "类别")
|
||||
|
||||
' 遍历每个订单，收集数据
|
||||
Dim i As Long
|
||||
Dim orderNo As String
|
||||
Dim modelStr As String
|
||||
Dim materials As collection
|
||||
Dim mat As clsMaterialItem
|
||||
Dim processedCount As Long
|
||||
Dim materialCount As Long
|
||||
|
||||
processedCount = 0
|
||||
materialCount = 0
|
||||
|
||||
For i = 2 To lastRow
|
||||
orderNo = Trim(wsOrders.Cells(i, 1).value)
|
||||
modelStr = Trim(wsOrders.Cells(i, 2).value)
|
||||
|
||||
' 跳过空行
|
||||
If orderNo = "" And modelStr = "" Then
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
' 验证必填字段
|
||||
If orderNo = "" Then
|
||||
orderNo = "(未填写)"
|
||||
End If
|
||||
|
||||
If modelStr = "" Then
|
||||
outputData.Add Array(orderNo, "(空白型号)", "错误", "产品型号为空", "", "", "")
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
' 获取物料
|
||||
On Error Resume Next
|
||||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "", True)
|
||||
On Error GoTo 0
|
||||
|
||||
If materials Is Nothing Then
|
||||
outputData.Add Array(orderNo, modelStr, "错误", "无法解析型号或获取物料", "", "", "")
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
' 收集物料明细
|
||||
If materials.Count > 0 Then
|
||||
For Each mat In materials
|
||||
outputData.Add Array( _
|
||||
orderNo, _
|
||||
modelStr, _
|
||||
mat.code, _
|
||||
mat.Name, _
|
||||
mat.Quantity, _
|
||||
IIf(mat.Condition = "", "(无条件)", mat.Condition), _
|
||||
mat.Category _
|
||||
)
|
||||
materialCount = materialCount + 1
|
||||
Next mat
|
||||
Else
|
||||
outputData.Add Array(orderNo, modelStr, "(无)", "未找到任何匹配物料", "", "", "")
|
||||
End If
|
||||
|
||||
processedCount = processedCount + 1
|
||||
|
||||
ContinueLoop:
|
||||
Next i
|
||||
|
||||
' 创建输出工作表
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("产品订单物料清单").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsOutput = ThisWorkbook.Worksheets.Add
|
||||
wsOutput.Name = "产品订单物料清单"
|
||||
|
||||
' 批量写入数据到工作表
|
||||
If outputData.Count > 0 Then
|
||||
Dim dataArray() As Variant
|
||||
ReDim dataArray(1 To outputData.Count, 1 To 7)
|
||||
|
||||
Dim j As Long
|
||||
Dim rowArr As Variant
|
||||
For j = 1 To outputData.Count
|
||||
rowArr = outputData(j)
|
||||
dataArray(j, 1) = rowArr(0)
|
||||
dataArray(j, 2) = rowArr(1)
|
||||
dataArray(j, 3) = rowArr(2) ' 这里是物料代码
|
||||
dataArray(j, 4) = rowArr(3)
|
||||
dataArray(j, 5) = rowArr(4)
|
||||
dataArray(j, 6) = rowArr(5)
|
||||
dataArray(j, 7) = rowArr(6)
|
||||
Next j
|
||||
|
||||
' --- 关键修改：在写入数据前，将 C 列设置为文本格式 ---
|
||||
' 使用 NumberFormat = "@" 强制指定为文本格式
|
||||
wsOutput.Columns("C").NumberFormat = "@"
|
||||
|
||||
' 一次性写入
|
||||
wsOutput.Range("A1").Resize(outputData.Count, 7).value = dataArray
|
||||
|
||||
' 格式化表头
|
||||
With wsOutput.Range("A1:G1")
|
||||
.Font.Bold = True
|
||||
.Interior.Color = RGB(200, 200, 200)
|
||||
' 表头所在的 C1 单元格通常可以改回常规格式，或者保持文本格式也不影响
|
||||
.NumberFormat = "General"
|
||||
End With
|
||||
End If
|
||||
|
||||
' 格式化
|
||||
wsOutput.Columns("A:G").AutoFit
|
||||
|
||||
' 显示统计信息
|
||||
Dim msg As String
|
||||
msg = "批量处理完成！" & vbCrLf & vbCrLf
|
||||
msg = msg & "处理订单数: " & processedCount & vbCrLf
|
||||
msg = msg & "生成物料记录: " & materialCount & " 条" & vbCrLf & vbCrLf
|
||||
msg = msg & "请查看工作表: 产品订单物料清单"
|
||||
|
||||
MsgBox msg, vbInformation
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例9: 批量处理订单 - 带完整性检查与模块数量校验
|
||||
' 功能：
|
||||
' 1. 提取型号条件
|
||||
' 2. 校验模块数量（如果是3个模块则报错）
|
||||
' 3. 校验类别完整性（如果缺失类别则报错）
|
||||
' 4. 生成BOM清单
|
||||
' ========================================
|
||||
Sub Example9_BatchProcessOrders_WithCheck()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsConfig As Worksheet, wsPlatform As Worksheet, wsOrders As Worksheet, wsOutput As Worksheet
|
||||
Dim parser As clsModelParser
|
||||
Dim extractor As clsConditionExtractor
|
||||
|
||||
' 1. 初始化与加载数据
|
||||
On Error Resume Next
|
||||
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
|
||||
On Error GoTo 0
|
||||
|
||||
If wsConfig Is Nothing Or wsPlatform Is Nothing Or wsOrders Is Nothing Then
|
||||
MsgBox "错误：缺少必要的工作表 (领料配置/平台配置清单/产品订单)", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
bomMgr.LoadData wsConfig, wsPlatform
|
||||
|
||||
' 2. 准备输出容器
|
||||
Dim outputData As collection
|
||||
Set outputData = New collection
|
||||
' 添加表头
|
||||
outputData.Add Array("来源单号", "产品型号", "物料代码", "物料名称", "数量", "选择条件", "提取的物料选择条件", "类别", "备注")
|
||||
|
||||
' 3. 遍历订单
|
||||
Dim lastRow As Long
|
||||
lastRow = wsOrders.Cells(wsOrders.Rows.Count, "A").End(xlUp).row
|
||||
|
||||
Dim i As Long
|
||||
Dim orderNo As String, modelStr As String
|
||||
Dim extractedCondStr As String
|
||||
Dim parts() As String
|
||||
Dim moduleCount As Integer
|
||||
Dim result As collection, materials As collection, missingCats As collection
|
||||
Dim isComplete As Boolean
|
||||
Dim mat As clsMaterialItem
|
||||
|
||||
' 辅助变量
|
||||
Dim key As Variant
|
||||
Dim missingStr As String
|
||||
Dim catItem As Variant
|
||||
|
||||
For i = 2 To lastRow
|
||||
orderNo = Trim(wsOrders.Cells(i, 1).value)
|
||||
modelStr = Trim(wsOrders.Cells(i, 2).value)
|
||||
|
||||
If orderNo = "" And modelStr = "" Then GoTo NextOrder
|
||||
If orderNo = "" Then orderNo = "(未填写)"
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 A: 解析型号并提取条件字符串 (用于输出列)
|
||||
' -------------------------------------------------
|
||||
extractedCondStr = ""
|
||||
Set parser = New clsModelParser
|
||||
Set extractor = New clsConditionExtractor
|
||||
|
||||
If parser.ParseModel(modelStr) Then
|
||||
Dim conditions As Object
|
||||
Set conditions = extractor.ExtractConditions(parser)
|
||||
For Each key In conditions.Keys
|
||||
extractedCondStr = extractedCondStr & key & "=" & conditions(key) & "; "
|
||||
Next key
|
||||
If Len(extractedCondStr) > 2 Then extractedCondStr = Left(extractedCondStr, Len(extractedCondStr) - 2)
|
||||
Else
|
||||
' 解析失败直接输出错误
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", "", "", "解析失败: " & parser.ErrorMessage)
|
||||
GoTo NextOrder
|
||||
End If
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 B: 校验模块数量 (表头 | 表盘 | 附件 | 法兰)
|
||||
' -------------------------------------------------
|
||||
' Split返回0-based数组。0=1个模块, 1=2个模块, 2=3个模块
|
||||
parts = Split(modelStr, "|")
|
||||
moduleCount = UBound(parts) + 1
|
||||
|
||||
' 规则：如果出现三个模块，不输出物料，备注填入原因
|
||||
If moduleCount = 3 Then
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "包含其它模块")
|
||||
GoTo NextOrder
|
||||
End If
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 C: 获取物料并校验类别完整性
|
||||
' -------------------------------------------------
|
||||
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
|
||||
|
||||
isComplete = result("IsComplete")
|
||||
Set materials = result("Materials")
|
||||
Set missingCats = result("MissingCategories")
|
||||
|
||||
' 规则：如果类别缺失，不输出物料，备注填入缺失的类别
|
||||
If Not isComplete Then
|
||||
missingStr = ""
|
||||
For Each catItem In missingCats
|
||||
missingStr = missingStr & catItem & ", "
|
||||
Next catItem
|
||||
|
||||
If Len(missingStr) > 2 Then missingStr = Left(missingStr, Len(missingStr) - 2)
|
||||
If missingStr = "" Then missingStr = "完整性校验未通过(未知原因)" ' 防御性编程
|
||||
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "类别缺失: " & missingStr)
|
||||
GoTo NextOrder
|
||||
End If
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 D: 正常输出物料
|
||||
' -------------------------------------------------
|
||||
If materials.Count > 0 Then
|
||||
For Each mat In materials
|
||||
outputData.Add Array( _
|
||||
orderNo, _
|
||||
modelStr, _
|
||||
mat.code, _
|
||||
mat.Name, _
|
||||
mat.Quantity, _
|
||||
IIf(mat.Condition = "", "(无条件)", mat.Condition), _
|
||||
extractedCondStr, _
|
||||
mat.Category, _
|
||||
"" _
|
||||
)
|
||||
Next mat
|
||||
Else
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "无匹配物料")
|
||||
End If
|
||||
|
||||
NextOrder:
|
||||
Next i
|
||||
|
||||
' 4. 写入结果到新工作表
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("订单BOM_校验版").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsOutput = ThisWorkbook.Worksheets.Add
|
||||
wsOutput.Name = "订单BOM_校验版"
|
||||
|
||||
If outputData.Count > 0 Then
|
||||
' 转换为二维数组以提高写入速度
|
||||
Dim dataArr() As Variant
|
||||
ReDim dataArr(1 To outputData.Count, 1 To 9)
|
||||
|
||||
Dim r As Long, c As Long
|
||||
Dim rowItem As Variant
|
||||
|
||||
For r = 1 To outputData.Count
|
||||
rowItem = outputData(r)
|
||||
For c = 0 To 8
|
||||
dataArr(r, c + 1) = rowItem(c)
|
||||
Next c
|
||||
Next r
|
||||
|
||||
' 设置物料代码列(C列)为文本格式
|
||||
wsOutput.Columns("C:C").NumberFormat = "@"
|
||||
|
||||
' 写入数据
|
||||
wsOutput.Range("A1").Resize(outputData.Count, 9).value = dataArr
|
||||
|
||||
' 格式化美化
|
||||
With wsOutput.Range("A1:I1")
|
||||
.Font.Bold = True
|
||||
.Interior.Color = RGB(220, 230, 241)
|
||||
.HorizontalAlignment = xlCenter
|
||||
End With
|
||||
|
||||
wsOutput.Columns("A:I").AutoFit
|
||||
' 备注列标红显示
|
||||
wsOutput.Columns("I:I").Font.Color = RGB(255, 0, 0)
|
||||
wsOutput.Cells(1, 9).Font.Color = RGB(0, 0, 0) ' 表头改回黑色
|
||||
End If
|
||||
|
||||
MsgBox "处理完成！请查看工作表 '订单BOM_校验版'。", vbInformation
|
||||
End Sub
|
||||
@@ -31,6 +31,18 @@
|
||||
"attributes": {},
|
||||
"file": "DocumentModules\\Sheet4.cls"
|
||||
},
|
||||
"clsMaterialWithFlag.cls": {
|
||||
"name": "clsMaterialWithFlag",
|
||||
"type": "ClassModules",
|
||||
"attributes": {},
|
||||
"file": "ClassModules\\clsMaterialWithFlag.cls"
|
||||
},
|
||||
"Sheet9.cls": {
|
||||
"name": "Sheet9",
|
||||
"type": "DocumentModules",
|
||||
"attributes": {},
|
||||
"file": "DocumentModules\\Sheet9.cls"
|
||||
},
|
||||
"clsCategory.cls": {
|
||||
"name": "clsCategory",
|
||||
"type": "ClassModules",
|
||||
@@ -55,12 +67,6 @@
|
||||
"attributes": {},
|
||||
"file": "ClassModules\\clsBOMManager.cls"
|
||||
},
|
||||
"Sheet6.cls": {
|
||||
"name": "Sheet6",
|
||||
"type": "DocumentModules",
|
||||
"attributes": {},
|
||||
"file": "DocumentModules\\Sheet6.cls"
|
||||
},
|
||||
"clsModelParser.cls": {
|
||||
"name": "clsModelParser",
|
||||
"type": "ClassModules",
|
||||
@@ -90,6 +96,24 @@
|
||||
"type": "Modules",
|
||||
"attributes": {},
|
||||
"file": "Modules\\modModelParserExamples.bas"
|
||||
},
|
||||
"Sheet16.cls": {
|
||||
"name": "Sheet16",
|
||||
"type": "DocumentModules",
|
||||
"attributes": {},
|
||||
"file": "DocumentModules\\Sheet16.cls"
|
||||
},
|
||||
"Sheet8.cls": {
|
||||
"name": "Sheet8",
|
||||
"type": "DocumentModules",
|
||||
"attributes": {},
|
||||
"file": "DocumentModules\\Sheet8.cls"
|
||||
},
|
||||
"Sheet11.cls": {
|
||||
"name": "Sheet11",
|
||||
"type": "DocumentModules",
|
||||
"attributes": {},
|
||||
"file": "DocumentModules\\Sheet11.cls"
|
||||
}
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user