VBA技术问询：如何在分组物料编号列表中标记旧版本并配合现有宏完成删除

你提到每周会导出带版本标识的物料编号列表，需要把每组物料里的旧版本标红，只保留最新版，再删除标红的行。你已经有删除红文本行的宏，但缺关键的旧版本标红部分，我来帮你补全并优化整个流程。

第一步：实现旧版本标红的VBA代码 #

核心思路是先把物料编号按前缀（去掉末尾版本字母）分组，然后在每组里找出版本字母最大的那个（也就是最新版），把其他行的文本标红。这里用字典来高效分组，代码如下：

Sub MarkOldVersionsRed()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim itemPrefix As String
    Dim version As String
    Dim itemDict As Object
    Dim key As Variant
    Dim maxVersion As String
    Dim rowList As Collection
    Dim i As Integer
    
    ' 设置当前工作表，可根据需要修改
    Set ws = ActiveSheet
    ' 获取A列最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 创建字典用于分组物料
    Set itemDict = CreateObject("Scripting.Dictionary")
    
    ' 第一步：遍历所有物料，按前缀分组
    For Each cell In ws.Range("A1:A" & lastRow)
        ' 提取物料前缀（去掉末尾的空格和版本字母）
        itemPrefix = Left(cell.Value, Len(cell.Value) - 2)
        ' 提取版本字母
        version = Right(cell.Value, 1)
        
        ' 如果字典里没有这个前缀，创建新集合
        If Not itemDict.Exists(itemPrefix) Then
            Set rowList = New Collection
            itemDict.Add itemPrefix, rowList
        End If
        ' 将当前行号和版本号存入集合，格式为"行号|版本"
        itemDict(itemPrefix).Add cell.Row & "|" & version
    Next cell
    
    ' 第二步：遍历每个分组，标记旧版本为红色
    For Each key In itemDict.Keys
        maxVersion = "A" ' 初始化最小版本
        ' 先找出当前组的最大版本
        For i = 1 To itemDict(key).Count
            version = Split(itemDict(key)(i), "|")(1)
            If version > maxVersion Then
                maxVersion = version
            End If
        Next i
        
        ' 把不是最大版本的行标红
        For i = 1 To itemDict(key).Count
            rowNum = Split(itemDict(key)(i), "|")(0)
            version = Split(itemDict(key)(i), "|")(1)
            If version <> maxVersion Then
                ws.Cells(rowNum, "A").Font.ColorIndex = 3 ' 3代表红色
            End If
        Next i
    Next key
    
    MsgBox "旧版本标记完成！", vbInformation
End Sub

第二步：整合并优化删除红文本行的宏 #

你原有的删除宏存在几个小问题：比如MsgBox里的lRows是拼写错误（应该是lRow），而且不管用户选Yes还是No，都会执行删除操作。我把它和标红宏整合，修复这些问题：

Sub ProcessMaterialVersions()
    ' 先执行旧版本标红
    MarkOldVersionsRed
    
    Dim lRow As Long
    Dim iCntr As Long
    Dim vbAnswer As VbMsgBoxResult
    
    ' 获取A列最后一行数据（避免硬编码20000）
    lRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    
    vbAnswer = MsgBox(lRow & " 行数据中，旧版本已标红。是否删除标红的行？", vbYesNo, "删除旧版本行")
    If vbAnswer = vbYes Then
        ' 从下往上遍历删除，避免行号错乱
        Application.ScreenUpdating = False ' 关闭屏幕刷新，提升速度
        For iCntr = lRow To 1 Step -1
            If Cells(iCntr, 1).Font.ColorIndex = 3 Then
                Rows(iCntr).Delete
            End If
        Next iCntr
        Application.ScreenUpdating = True ' 恢复屏幕刷新
        MsgBox "旧版本行已删除！", vbInformation
    Else
        MsgBox "操作已取消。", vbInformation
    End If
End Sub

使用说明 #

• 打开你的物料列表Excel文件，按下Alt + F11打开VBA编辑器
• 插入一个新模块：右键点击工程资源管理器里的工作簿名 → 插入 → 模块
• 把上面两段代码粘贴到模块里
• 回到Excel界面，按下Alt + F8，选择ProcessMaterialVersions宏并执行

这样就能一次性完成旧版本标红和删除的操作啦。

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