VBA字典数组BOM表物料编码匹配查询程序 - 优化物料规格字符处理、重复行匹配和一码多物情况

{"title":"VBA字典数组BOM表物料编码匹配查询程序 - 优化物料规格字符处理、重复行匹配和一码多物情况","description":"使用VBA字典和数组实现BOM表物料编码查询匹配程序，支持对物料规格进行字符处理，匹配重复行数据和一码多物情况，并根据匹配类型用不同颜色字体显示结果。","keywords":"VBA, 字典, 数组, BOM表, 物料编码, 查询匹配, 规格处理, 重复行, 一码多物, 字符处理, 字体颜色","content":"请注意，VBA中没有内置的字典数据结构，但可以使用Collection对象来实现类似字典的功能。\n\n以下是一个示例代码，用于对BOM表进行查询匹配物料代码的处理：\n\nvba\nSub MatchMaterials()\n Dim bomSheet As Worksheet\n Dim materialSheet As Worksheet\n Dim bomRange As Range\n Dim materialRange As Range\n Dim bomDict As Collection\n Dim bomRow As Range\n Dim materialRow As Range\n Dim bomCode As String\n Dim bomName As String\n Dim bomSpec As String\n Dim materialCode As String\n Dim materialName As String\n Dim materialSpec As String\n Dim matchType As String\n \n ' 设置BOM表和物料表的工作表\n Set bomSheet = ThisWorkbook.Worksheets("BOM表")\n Set materialSheet = ThisWorkbook.Worksheets("物料表")\n \n ' 设置BOM表和物料表的数据范围\n Set bomRange = bomSheet.Range("A2:C" & bomSheet.Cells(Rows.Count, 1).End(xlUp).Row)\n Set materialRange = materialSheet.Range("A2:C" & materialSheet.Cells(Rows.Count, 1).End(xlUp).Row)\n \n ' 创建BOM表的字典\n Set bomDict = New Collection\n \n ' 将物料表数据添加到字典中\n For Each materialRow In materialRange.Rows\n materialCode = Trim(materialRow.Cells(1).Value)\n materialName = Trim(materialRow.Cells(2).Value)\n materialSpec = Trim(materialRow.Cells(3).Value)\n \n ' 如果物料编码已存在于字典中，则跳过该行\n On Error Resume Next\n bomDict.Add materialCode, materialCode\n On Error GoTo 0\n Next materialRow\n \n ' 处理BOM表数据\n For Each bomRow In bomRange.Rows\n bomCode = Trim(bomRow.Cells(1).Value)\n bomName = Trim(bomRow.Cells(2).Value)\n bomSpec = Trim(bomRow.Cells(3).Value)\n \n ' 初始化匹配类型\n matchType = ""\n \n ' 完全匹配\n If bomName = materialName And bomSpec = materialSpec Then\n bomRow.Cells(1).Font.Color = RGB(0, 0, 0) ' 黑色字体\n matchType = "完全匹配"\n Else\n ' 仅规格匹配\n For Each materialRow In materialRange.Rows\n materialCode = Trim(materialRow.Cells(1).Value)\n materialName = Trim(materialRow.Cells(2).Value)\n materialSpec = Trim(materialRow.Cells(3).Value)\n \n If bomSpec = materialSpec Then\n bomRow.Cells(1).Font.Color = RGB(0, 176, 80) ' 绿色字体\n matchType = "仅规格匹配"\n Exit For\n End If\n Next materialRow\n \n ' 规格处理匹配\n If matchType = "" Then\n For Each materialRow In materialRange.Rows\n materialCode = Trim(materialRow.Cells(1).Value)\n materialName = Trim(materialRow.Cells(2).Value)\n materialSpec = Trim(materialRow.Cells(3).Value)\n \n ' 在字符处理后比较规格\n If UCase(Trim(bomSpec)) = UCase(Trim(materialSpec)) Then\n bomRow.Cells(1).Font.Color = RGB(255, 0, 0) ' 红色字体\n matchType = "规格处理匹配"\n Exit For\n End If\n Next materialRow\n End If\n \n ' 模糊匹配\n If matchType = "" Then\n For Each materialRow In materialRange.Rows\n materialCode = Trim(materialRow.Cells(1).Value)\n materialName = Trim(materialRow.Cells(2).Value)\n materialSpec = Trim(materialRow.Cells(3).Value)\n \n ' 在字符处理后比较规格\n If UCase(Trim(bomSpec)) Like "*" & UCase(Trim(materialSpec)) & "*" Then\n bomRow.Cells(1).Font.Color = RGB(255, 140, 0) ' 橙色倾斜字体\n bomRow.Cells(1).Font.Italic = True\n matchType = "模糊匹配"\n Exit For\n End If\n Next materialRow\n End If\n End If\n \n ' 在第四列显示匹配类型\n bomRow.Cells(4).Value = matchType\n Next bomRow\nEnd Sub\n\n\n请将以上代码复制到VBA编辑器中的模块中，并根据实际情况修改工作表名称和数据范围。然后运行MatchMaterials过程，即可对BOM表进行查询匹配物料代码的处理。匹配结果将在BOM表的第一列显示，并根据匹配类型使用不同颜色的字体进行标记。匹配类型将在BOM表的第四列显示。