需求：基于Z列唯一值追踪新旧表格变更的VBA代码

嘿，我知道你之前尝试基于Z列唯一值对比新旧工作表时碰了壁，别担心，下面这段VBA代码正好能满足你的需求——它会以Z列的唯一值作为匹配键，精准对比两个工作表的数值内容（而非单元格格式），还会自动高亮NEW工作表里的新增订单号，帮你快速追踪变更。

完整VBA代码 #

Sub TrackChangesByUniqueZValue()
    Dim wsOld As Worksheet, wsNew As Worksheet
    Dim uniqueZDict As Object
    Dim lastRowOld As Long, lastRowNew As Long
    Dim i As Long, j As Long, matchRow As Long
    Dim isNewOrder As Boolean
    
    ' 初始化工作表对象（请确保工作表名称与你的文件一致）
    Set wsOld = ThisWorkbook.Worksheets("OLD")
    Set wsNew = ThisWorkbook.Worksheets("NEW")
    Set uniqueZDict = CreateObject("Scripting.Dictionary")
    
    ' 清除之前的高亮标记（可选操作）
    wsNew.Cells.Interior.ColorIndex = xlNone
    
    ' 收集OLD表Z列的唯一值及对应行号
    lastRowOld = wsOld.Cells(wsOld.Rows.Count, "Z").End(xlUp).Row
    For i = 2 To lastRowOld ' 假设第1行是表头，从第2行开始处理数据
        Dim zValueOld As Variant
        zValueOld = wsOld.Cells(i, "Z").Value
        If Not uniqueZDict.Exists(zValueOld) Then
            uniqueZDict.Add zValueOld, i ' 存储Z值对应的行号，方便快速查找
        End If
    Next i
    
    ' 遍历NEW表，对比并标记变更
    lastRowNew = wsNew.Cells(wsNew.Rows.Count, "Z").End(xlUp).Row
    For i = 2 To lastRowNew ' 同样跳过表头行
        Dim zValueNew As Variant
        zValueNew = wsNew.Cells(i, "Z").Value
        isNewOrder = False
        
        ' 检查是否为新增订单号
        If Not uniqueZDict.Exists(zValueNew) Then
            isNewOrder = True
            wsNew.Rows(i).Interior.Color = RGB(146, 208, 80) ' 绿色高亮整行标记新订单
            wsNew.Cells(i, "Z").Value = wsNew.Cells(i, "Z").Value & " (new Order No.)" ' 添加文本标记
        Else
            ' 找到OLD表中对应的匹配行
            matchRow = uniqueZDict(zValueNew)
            
            ' 逐列对比数值（这里默认对比A到Y列，可根据需求调整范围）
            For j = 1 To 25 ' A列对应1，Y列对应25
                Dim valOld As Variant, valNew As Variant
                valOld = wsOld.Cells(matchRow, j).Value
                valNew = wsNew.Cells(i, j).Value
                
                ' 调用辅助函数精准对比数值
                If Not IsEqualValues(valOld, valNew) Then
                    wsNew.Cells(i, j).Interior.Color = RGB(255, 255, 0) ' 黄色高亮差异单元格
                End If
            Next j
        End If
    Next i
    
    MsgBox "变更追踪完成！新订单已高亮标记，数值差异已用黄色标注。", vbInformation
End Sub

' 辅助函数：处理空值、数值精度问题，确保只对比实际数值内容
Private Function IsEqualValues(val1 As Variant, val2 As Variant) As Boolean
    ' 处理双方都为空的情况
    If IsEmpty(val1) And IsEmpty(val2) Then
        IsEqualValues = True
        Exit Function
    End If
    ' 一方为空一方不为空的情况
    If IsEmpty(val1) Or IsEmpty(val2) Then
        IsEqualValues = False
        Exit Function
    End If
    
    ' 处理数值类型，避免浮点精度误差导致的误判
    If IsNumeric(val1) And IsNumeric(val2) Then
        IsEqualValues = Abs(val1 - val2) < 0.000001
        Exit Function
    End If
    
    ' 文本或其他类型直接对比
    IsEqualValues = (val1 = val2)
End Function

代码使用说明 #

• 工作表名称校验：请确保你的新旧工作表名称确实是OLD和NEW，如果不是，修改代码中Set wsOld = ...和Set wsNew = ...里的工作表名称。
• 自定义调整项：
  • 可以修改高亮颜色的RGB值，比如把新订单的绿色换成其他颜色
  • 调整对比的列范围：把j = 1 To 25改成你需要对比的列数（比如要对比到AA列就改成To 27）
  • 更改新订单的标记文本，比如把(new Order No.)换成你习惯的表述
• 效率优化：用字典存储唯一值比传统的查找函数快很多，适合数据量较大的表格。

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