40a9fe99f4
- Update GetValidMaterialsByModel to aggregate and return missing category names under the "MissingCategories" key. - Remove debug print statements and unused variables to improve code cleanliness. - Enhance result visualization to display completeness status with color formatting and detailed material tables.
634 lines
21 KiB
QBasic
634 lines
21 KiB
QBasic
' ========================================
|
||
' 模块: modModelParserExamples
|
||
' 用途: 型号解析与物料匹配的实际应用示例
|
||
' ========================================
|
||
Option Explicit
|
||
|
||
' ========================================
|
||
' 示例1: 根据型号生成完整的领料清单
|
||
' ========================================
|
||
Sub Example1_GeneratePickingListByModel()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsConfig As Worksheet
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsConfig, wsPlatform
|
||
|
||
' 产品型号
|
||
Dim modelStr As String
|
||
modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
|
||
|
||
' 创建领料清单工作表
|
||
Dim wsPickList As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("型号领料清单").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsPickList = ThisWorkbook.Worksheets.Add
|
||
wsPickList.Name = "型号领料清单"
|
||
|
||
' 写入表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsPickList.Cells(row, 1).value = "产品型号"
|
||
wsPickList.Cells(row, 2).value = modelStr
|
||
row = row + 1
|
||
|
||
' 提取条件并显示
|
||
Dim conditions As Object
|
||
Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
|
||
wsPickList.Cells(row, 1).value = "提取条件"
|
||
Dim condStr As String
|
||
Dim key As Variant
|
||
For Each key In conditions.Keys
|
||
condStr = condStr & key & "=" & conditions(key) & "; "
|
||
Next key
|
||
wsPickList.Cells(row, 2).value = condStr
|
||
row = row + 2
|
||
|
||
' 表头
|
||
wsPickList.Cells(row, 1).value = "类别"
|
||
wsPickList.Cells(row, 2).value = "代号"
|
||
wsPickList.Cells(row, 3).value = "名称"
|
||
wsPickList.Cells(row, 4).value = "数量"
|
||
wsPickList.Cells(row, 5).value = "选择条件"
|
||
wsPickList.Cells(row, 6).value = "匹配状态"
|
||
wsPickList.Range("A" & row & ":F" & row).Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 遍历所有根类别
|
||
Dim rootCats As collection
|
||
Set rootCats = bomMgr.GetRootCategories
|
||
|
||
Dim cat As clsCategory
|
||
Dim materials As collection
|
||
Dim mat As clsMaterialItem
|
||
Dim i As Long
|
||
|
||
For i = 1 To rootCats.Count
|
||
Set cat = rootCats(i)
|
||
|
||
' 获取该类别符合条件的物料
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, cat.categoryName)
|
||
|
||
' 写入物料
|
||
Dim j As Long
|
||
For j = 1 To materials.Count
|
||
Set mat = materials(j)
|
||
' 使用物料自己的Category属性，而不是外层循环的类别名称
|
||
' 这样当GetMaterialsByModel降级到子类别查找时，能正确显示子类别名称
|
||
wsPickList.Cells(row, 1).value = mat.Category
|
||
wsPickList.Cells(row, 2).value = mat.code
|
||
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 = "✓"
|
||
row = row + 1
|
||
Next j
|
||
Next i
|
||
|
||
' 格式化
|
||
wsPickList.Columns("A:F").AutoFit
|
||
|
||
MsgBox "领料清单生成完成！" & vbCrLf & _
|
||
"请查看工作表: 型号领料清单", vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例2: 批量处理多个型号
|
||
' ========================================
|
||
Sub Example2_BatchProcessModels()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsConfig As Worksheet
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsConfig, wsPlatform
|
||
|
||
' 型号列表
|
||
Dim models() As String
|
||
models = Split("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3," & _
|
||
"YTHN-100.A0.532.M203.M02.Y3|BP-095.2312.M02.PA3," & _
|
||
"YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", ",")
|
||
|
||
' 创建汇总表
|
||
Dim wsReport As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("批量型号汇总").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsReport = ThisWorkbook.Worksheets.Add
|
||
wsReport.Name = "批量型号汇总"
|
||
|
||
' 表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsReport.Cells(row, 1).value = "型号"
|
||
wsReport.Cells(row, 2).value = "提取条件"
|
||
wsReport.Cells(row, 3).value = "匹配物料数"
|
||
wsReport.Cells(row, 4).value = "部件物料"
|
||
wsReport.Range("A1:D1").Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 处理每个型号
|
||
Dim modelStr As String
|
||
Dim i As Long
|
||
|
||
For i = LBound(models) To UBound(models)
|
||
modelStr = Trim(models(i))
|
||
If modelStr <> "" Then
|
||
' 提取条件
|
||
Dim conditions As Object
|
||
Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
|
||
|
||
Dim condStr As String
|
||
condStr = ""
|
||
Dim key As Variant
|
||
For Each key In conditions.Keys
|
||
condStr = condStr & key & "=" & conditions(key) & "; "
|
||
Next key
|
||
|
||
' 获取物料
|
||
Dim materials As collection
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件")
|
||
|
||
' 写入结果
|
||
wsReport.Cells(row, 1).value = modelStr
|
||
wsReport.Cells(row, 2).value = condStr
|
||
wsReport.Cells(row, 3).value = materials.Count
|
||
|
||
' 列出部件物料
|
||
Dim matList As String
|
||
matList = ""
|
||
Dim mat As clsMaterialItem
|
||
For Each mat In materials
|
||
matList = matList & mat.code & "(" & mat.Name & "); "
|
||
Next mat
|
||
wsReport.Cells(row, 4).value = matList
|
||
|
||
row = row + 1
|
||
End If
|
||
Next i
|
||
|
||
' 格式化
|
||
wsReport.Columns("A:D").AutoFit
|
||
|
||
MsgBox "批量处理完成！", vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例3: 查询并显示某个型号的详细信息
|
||
' ========================================
|
||
Sub Example3_ShowModelDetails()
|
||
' 弹出输入框
|
||
Dim modelStr As String
|
||
modelStr = InputBox("请输入产品型号:", "型号查询", _
|
||
"YTHN-100.A0.532.M203.M16.Y3")
|
||
|
||
If modelStr = "" Then Exit Sub
|
||
|
||
' 解析型号
|
||
Dim parser As New clsModelParser
|
||
If Not parser.ParseModel(modelStr) Then
|
||
MsgBox "型号解析失败: " & parser.ErrorMessage, vbCritical
|
||
Exit Sub
|
||
End If
|
||
|
||
' 提取条件
|
||
Dim extractor As New clsConditionExtractor
|
||
Dim conditions As Object
|
||
Set conditions = extractor.ExtractConditions(parser)
|
||
|
||
' 显示详细信息
|
||
Dim msg As String
|
||
msg = "【型号解析结果】" & vbCrLf & vbCrLf
|
||
msg = msg & "原始型号: " & parser.RawModel & vbCrLf
|
||
msg = msg & "表头型号: " & parser.HeaderModel & vbCrLf
|
||
msg = msg & "表盘型号: " & parser.DialModel & vbCrLf & vbCrLf
|
||
|
||
msg = msg & "【表头各部分】" & vbCrLf
|
||
msg = msg & "型号: " & parser.ModelType & vbCrLf
|
||
msg = msg & "公称外径: " & parser.Diameter & vbCrLf
|
||
msg = msg & "安装形式: " & parser.InstallForm & vbCrLf
|
||
msg = msg & "壳体形式: " & parser.ShellForm & vbCrLf
|
||
msg = msg & "过程连接&材质: " & parser.ConnectionCode & vbCrLf
|
||
msg = msg & "量程范围: " & parser.RangeCode & vbCrLf
|
||
msg = msg & "仪表特性: " & parser.Characteristics & vbCrLf & vbCrLf
|
||
|
||
msg = msg & "【提取的物料选择条件】" & vbCrLf
|
||
Dim key As Variant
|
||
For Each key In conditions.Keys
|
||
msg = msg & key & " = " & conditions(key) & vbCrLf
|
||
Next key
|
||
|
||
MsgBox msg, vbInformation, "型号详细信息"
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例4: 对比两个型号的差异
|
||
' ========================================
|
||
Sub Example4_CompareModels()
|
||
Dim model1 As String, model2 As String
|
||
|
||
model1 = InputBox("请输入第一个型号:", "型号对比", _
|
||
"YTHN-100.A0.532.M203.M16.Y3")
|
||
If model1 = "" Then Exit Sub
|
||
|
||
model2 = InputBox("请输入第二个型号:", "型号对比", _
|
||
"YTHN-100.A0.532.M203.M02.Y3")
|
||
If model2 = "" Then Exit Sub
|
||
|
||
' 解析两个型号
|
||
Dim parser1 As New clsModelParser
|
||
Dim parser2 As New clsModelParser
|
||
Dim extractor As New clsConditionExtractor
|
||
|
||
parser1.ParseModel model1
|
||
parser2.ParseModel model2
|
||
|
||
Dim cond1 As Object, cond2 As Object
|
||
Set cond1 = extractor.ExtractConditions(parser1)
|
||
|
||
Set extractor = New clsConditionExtractor
|
||
Set cond2 = extractor.ExtractConditions(parser2)
|
||
|
||
' 对比
|
||
Dim msg As String
|
||
msg = "【型号对比】" & vbCrLf & vbCrLf
|
||
msg = msg & "型号1: " & model1 & vbCrLf
|
||
msg = msg & "型号2: " & model2 & vbCrLf & vbCrLf
|
||
|
||
msg = msg & "【条件差异】" & vbCrLf
|
||
Dim key As Variant
|
||
Dim allKeys As Object
|
||
Set allKeys = CreateObject("Scripting.Dictionary")
|
||
|
||
For Each key In cond1.Keys
|
||
allKeys(key) = True
|
||
Next key
|
||
For Each key In cond2.Keys
|
||
allKeys(key) = True
|
||
Next key
|
||
|
||
For Each key In allKeys.Keys
|
||
Dim val1 As String, val2 As String
|
||
val1 = ""
|
||
val2 = ""
|
||
|
||
If cond1.Exists(key) Then val1 = cond1(key)
|
||
If cond2.Exists(key) Then val2 = cond2(key)
|
||
|
||
If val1 <> val2 Then
|
||
msg = msg & key & ": " & val1 & " → " & val2 & " ?" & vbCrLf
|
||
Else
|
||
msg = msg & key & ": " & val1 & " ?" & vbCrLf
|
||
End If
|
||
Next key
|
||
|
||
MsgBox msg, vbInformation, "型号对比结果"
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例5: 验证物料选择条件的有效性
|
||
' ========================================
|
||
Sub Example5_ValidateMaterialConditions()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsConfig As Worksheet
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsConfig, wsPlatform
|
||
|
||
' 创建验证结果表
|
||
Dim wsValidation As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("条件验证结果").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsValidation = ThisWorkbook.Worksheets.Add
|
||
wsValidation.Name = "条件验证结果"
|
||
|
||
' 表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsValidation.Cells(row, 1).value = "代号"
|
||
wsValidation.Cells(row, 2).value = "名称"
|
||
wsValidation.Cells(row, 3).value = "选择条件"
|
||
wsValidation.Cells(row, 4).value = "验证结果"
|
||
wsValidation.Range("A1:D1").Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 获取所有根类别
|
||
Dim rootCats As collection
|
||
Set rootCats = bomMgr.GetRootCategories
|
||
|
||
Dim cat As clsCategory
|
||
Dim materials As collection
|
||
Dim mat As clsMaterialItem
|
||
Dim matcher As New clsConditionMatcher
|
||
Dim i As Long
|
||
|
||
' 遍历所有物料
|
||
For i = 1 To rootCats.Count
|
||
Set cat = rootCats(i)
|
||
Set materials = New collection
|
||
|
||
' 收集该类别的所有物料
|
||
Dim j As Long
|
||
For j = 1 To cat.materials.Count
|
||
materials.Add cat.materials(j)
|
||
Next j
|
||
|
||
' 验证每个物料的条件
|
||
For Each mat In materials
|
||
wsValidation.Cells(row, 1).value = mat.code
|
||
wsValidation.Cells(row, 2).value = mat.Name
|
||
wsValidation.Cells(row, 3).value = IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
|
||
If mat.Condition = "" Then
|
||
wsValidation.Cells(row, 4).value = "? 无条件"
|
||
Else
|
||
Dim validResult As String
|
||
validResult = matcher.TestExpression(mat.Condition)
|
||
wsValidation.Cells(row, 4).value = validResult
|
||
End If
|
||
|
||
row = row + 1
|
||
Next mat
|
||
Next i
|
||
|
||
' 格式化
|
||
wsValidation.Columns("A:D").AutoFit
|
||
|
||
MsgBox "条件验证完成！", vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例6: 对比启用/禁用自动降级的效果
|
||
' ========================================
|
||
Sub Example6_CompareAutoFallback()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsConfig As Worksheet
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsConfig, wsPlatform
|
||
|
||
' 产品型号（使用可能导致类别缺失的型号）
|
||
Dim modelStr As String
|
||
modelStr = "YTHN-100.A0.532.M203.M17.Y3|BP-095.2312.M16.PA3"
|
||
|
||
' 创建对比结果表
|
||
Dim wsCompare As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("降级模式对比").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsCompare = ThisWorkbook.Worksheets.Add
|
||
wsCompare.Name = "降级模式对比"
|
||
|
||
' 表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsCompare.Cells(row, 1).value = "型号"
|
||
wsCompare.Cells(row, 2).value = modelStr
|
||
row = row + 2
|
||
|
||
' 测试1: 启用自动降级
|
||
wsCompare.Cells(row, 1).value = "模式1: 启用自动降级 (autoFallback=True)"
|
||
wsCompare.Cells(row, 1).Font.Bold = True
|
||
row = row + 1
|
||
|
||
wsCompare.Cells(row, 1).value = "类别"
|
||
wsCompare.Cells(row, 2).value = "代号"
|
||
wsCompare.Cells(row, 3).value = "名称"
|
||
wsCompare.Cells(row, 4).value = "数量"
|
||
wsCompare.Cells(row, 5).value = "选择条件"
|
||
wsCompare.Range("A" & row & ":E" & row).Font.Bold = True
|
||
row = row + 1
|
||
|
||
Dim materials As collection
|
||
Dim mat As clsMaterialItem
|
||
Dim i As Long
|
||
|
||
' 获取启用自动降级的物料
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", True)
|
||
|
||
If materials.Count = 0 Then
|
||
wsCompare.Cells(row, 1).value = "(无物料)"
|
||
row = row + 1
|
||
Else
|
||
For i = 1 To materials.Count
|
||
Set mat = materials(i)
|
||
wsCompare.Cells(row, 1).value = mat.Category
|
||
wsCompare.Cells(row, 2).value = mat.code
|
||
wsCompare.Cells(row, 3).value = mat.Name
|
||
wsCompare.Cells(row, 4).value = mat.Quantity
|
||
wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
row = row + 1
|
||
Next i
|
||
End If
|
||
|
||
row = row + 1
|
||
|
||
' 测试2: 禁用自动降级
|
||
wsCompare.Cells(row, 1).value = "模式2: 禁用自动降级 (autoFallback=False)"
|
||
wsCompare.Cells(row, 1).Font.Bold = True
|
||
row = row + 1
|
||
|
||
wsCompare.Cells(row, 1).value = "类别"
|
||
wsCompare.Cells(row, 2).value = "代号"
|
||
wsCompare.Cells(row, 3).value = "名称"
|
||
wsCompare.Cells(row, 4).value = "数量"
|
||
wsCompare.Cells(row, 5).value = "选择条件"
|
||
wsCompare.Range("A" & row & ":E" & row).Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 获取禁用自动降级的物料
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", False)
|
||
|
||
If materials.Count = 0 Then
|
||
wsCompare.Cells(row, 1).value = "(无物料 - 因为禁用降级)"
|
||
wsCompare.Cells(row, 2).value = "说明"
|
||
wsCompare.Cells(row, 3).value = "当父类别无匹配物料时,不会降级到子类别查找"
|
||
row = row + 1
|
||
Else
|
||
For i = 1 To materials.Count
|
||
Set mat = materials(i)
|
||
wsCompare.Cells(row, 1).value = mat.Category
|
||
wsCompare.Cells(row, 2).value = mat.code
|
||
wsCompare.Cells(row, 3).value = mat.Name
|
||
wsCompare.Cells(row, 4).value = mat.Quantity
|
||
wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
row = row + 1
|
||
Next i
|
||
End If
|
||
|
||
' 添加说明
|
||
row = row + 1
|
||
wsCompare.Cells(row, 1).value = "说明:"
|
||
wsCompare.Cells(row, 1).Font.Bold = True
|
||
row = row + 1
|
||
wsCompare.Cells(row, 1).value = "• autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找"
|
||
row = row + 1
|
||
wsCompare.Cells(row, 1).value = "• autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合"
|
||
|
||
' 格式化
|
||
wsCompare.Columns("A:E").AutoFit
|
||
wsCompare.Range("A1").Font.Bold = True
|
||
|
||
MsgBox "降级模式对比完成！" & vbCrLf & _
|
||
"请查看工作表: 降级模式对比" & vbCrLf & vbCrLf & _
|
||
"启用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", True).Count & " 个物料" & vbCrLf & _
|
||
"禁用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", False).Count & " 个物料", _
|
||
vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例7: 测试GetValidMaterialsByModel方法 (使用内置的缺失列表)
|
||
' ========================================
|
||
Sub Example7_TestGetValidMaterialsByModel()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsConfig As Worksheet
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsConfig, wsPlatform
|
||
|
||
' 创建测试结果工作表
|
||
Dim wsTest As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("物料完整性测试").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsTest = ThisWorkbook.Worksheets.Add
|
||
wsTest.Name = "物料完整性测试"
|
||
|
||
' 写入标题
|
||
Dim row As Long
|
||
row = 1
|
||
wsTest.Cells(row, 1).value = "物料完整性测试报告"
|
||
wsTest.Cells(row, 1).Font.Bold = True
|
||
wsTest.Cells(row, 1).Font.Size = 14
|
||
row = row + 2
|
||
|
||
' 定义测试型号
|
||
Dim testModels() As Variant
|
||
testModels = Array( _
|
||
Array("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3", "完整型号测试1"), _
|
||
Array("YTHN-100.A0.532.M203.M17.Y3", "缺失子类别测试") _
|
||
)
|
||
|
||
Dim i As Long
|
||
For i = LBound(testModels) To UBound(testModels)
|
||
Dim modelStr As String
|
||
Dim testName As String
|
||
modelStr = testModels(i)(0)
|
||
testName = testModels(i)(1)
|
||
|
||
' 1. 调用方法获取结果
|
||
Dim result As collection
|
||
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
|
||
|
||
Dim materials As collection
|
||
Dim missingCats As collection
|
||
Dim isComplete As Boolean
|
||
|
||
Set materials = result("Materials")
|
||
Set missingCats = result("MissingCategories") ' 直接获取缺失列表
|
||
isComplete = result("IsComplete")
|
||
|
||
' 2. 写入头部信息
|
||
wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName
|
||
wsTest.Cells(row, 1).Font.Bold = True
|
||
wsTest.Cells(row, 1).Interior.Color = RGB(240, 240, 240)
|
||
row = row + 1
|
||
|
||
wsTest.Cells(row, 1).value = "型号:"
|
||
wsTest.Cells(row, 2).value = modelStr
|
||
row = row + 1
|
||
|
||
wsTest.Cells(row, 1).value = "完整性:"
|
||
wsTest.Cells(row, 2).value = IIf(isComplete, "✓ 完整", "✕ 不完整")
|
||
If isComplete Then
|
||
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
|
||
Else
|
||
wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
|
||
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 = "名称"
|
||
wsTest.Cells(row, 4).value = "数量"
|
||
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
|
||
For Each mat In materials
|
||
wsTest.Cells(row, 1).value = mat.Category
|
||
wsTest.Cells(row, 2).value = mat.code
|
||
wsTest.Cells(row, 3).value = mat.Name
|
||
wsTest.Cells(row, 4).value = mat.Quantity
|
||
row = row + 1
|
||
Next mat
|
||
Else
|
||
wsTest.Cells(row, 1).value = "(无)"
|
||
row = row + 1
|
||
End If
|
||
|
||
' 4. 打印缺失的类别 (新增核心功能)
|
||
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).Font.Color = RGB(255, 0, 0)
|
||
wsTest.Cells(row, 2).value = "未找到匹配物料"
|
||
row = row + 1
|
||
Next catName
|
||
End If
|
||
|
||
' 添加分隔行
|
||
row = row + 1
|
||
wsTest.Cells(row, 1).value = String(80, "-")
|
||
row = row + 2
|
||
Next i
|
||
|
||
wsTest.Columns("A:D").AutoFit
|
||
MsgBox "测试完成！", vbInformation
|
||
End Sub |