使用VBA为需装配产品分配CAD编号：重复项统一编号

以下是直接解决需求的VBA宏代码，无需辅助列，高效完成编号分配：

Sub AssignCADNumbers()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim uniqueKey As String
    Dim cadDict As Object
    Dim newCadNum As Integer
    
    ' 初始化字典用于存储唯一组合与对应编号
    Set cadDict = CreateObject("Scripting.Dictionary")
    ' 指定目标工作表（替换为你的表名）
    Set ws = ThisWorkbook.Worksheets("ProductList")
    ' 获取数据区域最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历数据行（假设表头在第1行，从第2行开始处理）
    For i = 2 To lastRow
        ' 仅处理标记为"z"的需装配产品（标记列假设为E列，按需修改）
        If UCase(ws.Cells(i, "E").Value) = "Z" Then
            ' 生成唯一识别键：Item+Length+Width+Height，用|分隔避免拼接冲突
            uniqueKey = Trim(ws.Cells(i, "A").Value) & "|" & _
                        Trim(CStr(ws.Cells(i, "B").Value)) & "|" & _
                        Trim(CStr(ws.Cells(i, "C").Value)) & "|" & _
                        Trim(CStr(ws.Cells(i, "D").Value))
            
            ' 检查是否已有对应编号
            If cadDict.Exists(uniqueKey) Then
                ws.Cells(i, "F").Value = cadDict(uniqueKey)
            Else
                ' 分配新编号
                newCadNum = cadDict.Count + 1
                cadDict.Add uniqueKey, newCadNum
                ws.Cells(i, "F").Value = newCadNum
            End If
        Else
            ' 无需装配，清空编号列
            ws.Cells(i, "F").Value = ""
        End If
    Next i
    
    ' 释放内存
    Set cadDict = Nothing
    MsgBox "CAD编号分配完成", vbInformation
End Sub

代码说明 #

• 核心逻辑：利用Scripting.Dictionary存储已出现的Item+Length+Width+Height组合，确保相同组合复用同一编号，遍历一次数据即可完成，比公式法效率提升显著
• 键生成：用|作为分隔符，避免不同组合拼接后出现重复（例如Item="AB"+Length="C" 与 Item="A"+Length="BC" 的冲突）
• 兼容性：用UCase统一标记值大小写，用CStr转换数值型尺寸为字符串，避免格式差异导致的误判

使用注意事项 #

1. 根据你的表格结构修改列标识：
   • ws.Cells(i, "A") → Item所在列
   • ws.Cells(i, "B/C/D") → Length/Width/Height所在列
   • ws.Cells(i, "E") → 装配标记列（值为"z"）
   • ws.Cells(i, "F") → CAD编号写入列
2. 若表头不在第1行，修改循环起始行（例如For i = 3 To lastRow）
3. 运行宏前建议备份文件，避免数据意外修改

内容的提问来源于stack exchange，提问作者NoobInLifeGeneral