如何实现仅在拼接区域内容变更时更新的Excel动态时间戳？

问题背景 #

需要实现一个动态时间戳，仅当目标拼接区域的内容发生变化时才更新；但当前使用自定义函数时，编辑目标区域（如B:E列）能正常更新时间戳，筛选行、删除单元格等操作也会触发时间戳更新，不符合需求。希望使用针对区域的函数，而非硬编码固定范围。

当前使用的自定义函数代码：

Function MyTimestamp(Reference As Range)
    If Reference.Text <> "" Then
        MyTimestamp = Format(Now, "#.#############")
    Else
        MyTimestamp = ""
    End If
End Function

解决方案：基于哈希对比的VBA函数 #

自定义函数会因Excel全局计算触发（筛选、删除单元格都会触发）而更新，因此需要通过存储参考区域内容的历史哈希值，仅当内容真正变化时才更新时间戳。

步骤1：准备哈希存储工作表

插入一个新工作表，命名为HashStorage，右键设置为「非常隐藏」（避免误编辑）。

步骤2：替换为以下VBA代码

Function MyTimestamp(Reference As Range) As Variant
    Dim wsHash As Worksheet
    Dim key As String
    Dim currentHash As String
    Dim storedHash As String
    
    ' 计算当前参考区域的内容哈希
    currentHash = GetRangeHash(Reference)
    ' 生成唯一标识键：工作表名+行号，避免不同行冲突
    key = Reference.Parent.Name & "_" & Reference.Row
    
    ' 初始化哈希存储表
    On Error Resume Next
    Set wsHash = ThisWorkbook.Worksheets("HashStorage")
    On Error GoTo 0
    If wsHash Is Nothing Then
        Set wsHash = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsHash.Name = "HashStorage"
        wsHash.Visible = xlSheetVeryHidden
    End If
    
    ' 读取已存储的哈希值
    storedHash = wsHash.Cells(Application.Match(key, wsHash.Columns(1), 0), 2)
    
    ' 对比哈希，仅变化时更新时间戳
    If currentHash <> storedHash Then
        MyTimestamp = IIf(Reference.Text <> "", Format(Now, "#.#############"), "")
        ' 更新存储的哈希值
        On Error Resume Next
        wsHash.Cells(Application.Match(key, wsHash.Columns(1), 0), 2) = currentHash
        If Err.Number <> 0 Then
            ' 无记录则新增
            Dim lastRow As Long
            lastRow = wsHash.Cells(wsHash.Rows.Count, 1).End(xlUp).Row + 1
            wsHash.Cells(lastRow, 1) = key
            wsHash.Cells(lastRow, 2) = currentHash
        End If
        On Error GoTo 0
    Else
        ' 哈希未变，返回当前单元格已有值
        MyTimestamp = Application.Caller.Value
    End If
End Function

' 辅助函数：计算区域内容的MD5哈希
Private Function GetRangeHash(rng As Range) As String
    Dim cell As Range
    Dim concatText As String
    concatText = ""
    For Each cell In rng
        concatText = concatText & cell.Value & "|" ' 用分隔符避免值拼接混淆
    Next cell
    
    Dim hasher As Object
    Set hasher = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    Dim bytes() As Byte
    bytes = hasher.ComputeHash(StrConv(concatText, vbFromUnicode))
    GetRangeHash = BytesToHex(bytes)
End Function

' 辅助函数：字节数组转十六进制字符串
Private Function BytesToHex(bytes() As Byte) As String
    Dim i As Integer
    Dim hexStr As String
    hexStr = ""
    For i = LBound(bytes) To UBound(bytes)
        hexStr = hexStr & Right("0" & Hex(bytes(i)), 2)
    Next i
    BytesToHex = hexStr
End Function

使用说明

1. 在目标单元格（如G2）输入公式=MyTimestamp(B2:E2)，对应该行的B-E列区域
2. 首次使用需启用Microsoft Scripting Runtime：打开VBA编辑器 → 工具 → 引用 → 勾选「Microsoft Scripting Runtime」
3. 筛选、删除单元格等操作不会触发时间戳更新，仅当目标区域内容修改时才会更新

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