如何用VBA查找SKU列中各设计对应的首个唯一值？

核心逻辑 #

1. 拆分ID的设计部分与尺寸部分，提取出唯一的设计标识（比如从CEN101A-6中提取CEN101A）
2. 用字典存储每个设计首次出现的完整ID作为父项
3. 遍历所有数据行，为每个条目匹配对应的父项并写入指定列

VBA代码实现 #

Sub SetParentIDs()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim designDict As Object
    Dim i As Long
    Dim idStr As String
    Dim designPart As String
    
    ' 设置目标工作表，可根据实际修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取数据最后一行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 创建字典存储首次出现的设计父项
    Set designDict = CreateObject("Scripting.Dictionary")
    
    ' 第一遍遍历：记录每个设计的首个条目
    For i = 2 To lastRow ' 假设第1行是表头
        idStr = ws.Cells(i, "A").Value
        ' 拆分设计部分（按最后一个"-"分割，适配不同长度的尺寸部分）
        designPart = Left(idStr, InStrRev(idStr, "-") - 1)
        ' 如果字典中没有该设计，记录当前ID为父项
        If Not designDict.Exists(designPart) Then
            designDict(designPart) = idStr
        End If
    Next i
    
    ' 第二遍遍历：为每个条目写入对应的父项
    For i = 2 To lastRow
        idStr = ws.Cells(i, "A").Value
        designPart = Left(idStr, InStrRev(idStr, "-") - 1)
        ' 将父项写入C列，可根据需求修改列号
        ws.Cells(i, "C").Value = designDict(designPart)
    Next i
    
    MsgBox "父项匹配完成！"
End Sub

使用说明 #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器
2. 右键点击左侧工程窗口中的工作表名称，选择「插入」→「模块」
3. 将上述代码粘贴到模块窗口中
4. 修改代码中的Sheet1为你的实际工作表名称，父项写入列C也可按需调整
5. 按下F5运行代码，完成后会弹出提示框

注意事项 #

• 确保ID的设计部分与尺寸部分以-分隔，且每个ID中只有一个-（如果有多个，代码会按最后一个-拆分，可根据实际情况调整拆分逻辑）
• 如果表头不在第1行，修改循环起始行的2为实际表头下的第一行

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