如何让VBA变量vOldValue获取多单元格选中区域的旧值

问题说明 #

我有一个Excel宏，会自动创建名为"Tracker"的工作表，用于记录工作簿内任意工作表的修改信息，涵盖以下字段：

• 修改的单元格地址
• 旧值
• 新值
• 旧公式
• 新公式
• 修改时间
• 修改日期
• 操作用户

当前宏存在的问题：当修改多个单元格时，无法记录每个单元格的旧值，只会在Tracker工作表的"旧值"列显示"Multiple Cells Selected"。需要调整代码，让已声明的变量vOldValue变为选中区域所有单元格值及对应地址组成的字符串。

修改后的完整VBA代码 #

Option Explicit
Dim sOldAddress As String
Dim vOldValue As Variant
Dim sOldFormula As String
 
Private Sub Workbook_TrackChange(Cancel As Boolean)
    Dim sh As Worksheet
    For Each sh In ActiveWorkbook.Worksheets
        sh.PageSetup.LeftFooter = "&06" & ActiveWorkbook.FullName & vbLf & "&A"
    Next sh
End Sub

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
     '''''''''''''''''''''''''''''''''''''''''''''
     'lenze 2003
     'Colin_L 2009
     'Mark Reierson 2009
     '''''''''''''''''''''''''''''''''''''''''''''
     
    Dim wSheet As Worksheet
    Dim wActSheet As Worksheet
    Dim iCol As Integer
    Set wActSheet = ActiveSheet
     
     '前置退出条件
     '可在此添加其他不需要追踪的操作条件
    'If vOldValue = "" Then Exit Sub '取消注释此行将记录所有修改操作
     
    '继续执行
     
    On Error Resume Next '仅用于处理Tracker工作表不存在时的创建逻辑
    Set wSheet = Sheets("Tracker")
     '**** 如果Tracker工作表不存在则创建 ****
     
    If wSheet Is Nothing Then
        Set wActSheet = ActiveSheet
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker"
    End If
    On Error GoTo 0
     '**** 特定错误处理结束 ****
     
    On Error GoTo ErrorHandler
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
     
    With Sheets("Tracker")
         '******** 当首列记录填满时，将追踪区域向右移动一列 ******'
        If .Cells(1, 1) = "" Then '
            iCol = 1 '
        Else '
            iCol = .Cells(1, 256).End(xlToLeft).Column - 7 '
            If Not .Cells(65536, iCol) = "" Then '
                iCol = .Cells(1, 256).End(xlToLeft).Column + 1 '
            End If '
        End If '
         '********* 区域移动逻辑结束 *************************************************'
        .Unprotect Password:="Secret"
         
         '******** 设置表头 **********************************************************
        If LenB(.Cells(1, iCol).Value) = 0 Then
            .Range(.Cells(1, iCol), .Cells(1, iCol + 7)) = Array("修改的单元格地址", "旧值", _
            "新值", "旧公式", "新公式", "修改时间", "修改日期", "操作用户")
            .Cells.Columns.AutoFit
        End If
         
        With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1)
             
            .Value = sOldAddress
             
            .Offset(0, 1).Value = vOldValue
            .Offset(0, 3).Value = sOldFormula
             
            If Target.Count = 1 Then
                .Offset(0, 2).Value = Target.Value
                If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
            End If
             
            .Offset(0, 5) = Time
            .Offset(0, 6) = Date
            .Offset(0, 7) = Application.UserName
            '.Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous '在行末添加边框线
        End With
         
         '.Protect Password:="Secret"  '取消注释以保护Tracker工作表
         
    End With
ErrorExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
     
    wActSheet.Activate
    Exit Sub
     
ErrorHandler:
     '自定义错误处理逻辑
     'Debug.Print "发生错误"
    Resume ErrorExit
     
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
     
    With Target
        sOldAddress = .Address(external:=True)
         
        If .Count > 1 Then
            '拼接多单元格的旧值，格式为"单元格地址: 值, 单元格地址: 值..."
            Dim cell As Range
            Dim valueStr As String
            valueStr = ""
            For Each cell In Target
                valueStr = valueStr & cell.Address & ": " & cell.Value & ", "
            Next cell
            '移除末尾多余的逗号和空格
            vOldValue = Left(valueStr, Len(valueStr) - 2)
            sOldFormula = vbNullString
             
        Else
             
            vOldValue = .Value
            If .HasFormula Then
                sOldFormula = "'" & Target.Formula
            Else
                sOldFormula = vbNullString
            End If
        End If
    End With
End Sub

关键修改说明 #

在Workbook_SheetSelectionChange事件中，针对多单元格选中的情况：

1. 新增cell和valueStr变量，分别用于遍历单元格和拼接值字符串
2. 循环遍历选中区域的每个单元格，将单元格地址与对应值拼接成指定格式的字符串
3. 移除字符串末尾多余的逗号和空格后，将结果赋值给vOldValue

修改完成后，Tracker工作表的"旧值"列会显示类似$A$1: 100, $B$1: 200的内容，清晰记录每个被修改单元格的原始值。

内容的提问来源于stack exchange，提问作者MS-HCL