Excel宏需求：修改指定区域单元格时在AN2显示对应姓名与城市

我目前使用以下Excel VBA宏实现修改单元格值时添加线程批注的功能：

Private Sub Worksheet_Change(ByVal Target As Range)
Const xRg As String = "C4:AK100"
Dim strOld As String
Dim strNew As String
Dim strCmt As String
Dim strCmt2 As String
Dim Cell As Range
Dim rngComm As Range
Dim ws As Worksheet`your text`
Dim c As Range
Dim Comment As CommentThreaded
With Target(1)
If Intersect(.Cells, Range(xRg)) Is Nothing Then Exit Sub
    strNew = .Text
    Application.EnableEvents = False
    Application.Undo
    strOld = .Text
    .Value = strNew
    Application.EnableEvents = True
    strCmt = "Uppdated: " & Format$(Now, "YYYY/ MM/ DD ") & Chr(10) & "By: " & _
    Application.UserName & Chr(10) & "Before update : " & strOld
    If Target(1).CommentThreaded Is Nothing Then
    .AddCommentThreaded (strCmt)
    ActiveCell.CommentThreaded.Resolved = True
strCmt2 = "Updated: " & Format$(Now, "YYYY/ MM/ DD ") & Chr(10) & "By: " & _
    Application.UserName & Chr(10)
Range("AM3").Value = strCmt2
    Range("AM2").Value = Now
    Range("AM2").NumberFormat = "YYYY-MM-DD"
Else
ActiveCell.ClearComments
strCmt = "Updated: " & Format$(Now, "YYYY/ MM/ DD ") & Chr(10) & "By: " & _
    Application.UserName & Chr(10) & "Before update : " & strOld
    If Target(1).CommentThreaded Is Nothing Then
    .AddCommentThreaded (strCmt)
    ActiveCell.CommentThreaded.Resolved = True
    Range("AM3").Value = strCmt2
    Range("AM2").Value = Now
    Range("AM2").NumberFormat = "YYYY-MM-DD"
    
End If
End If
End With
End Sub

现需为该宏添加功能：当修改C4:AK100区域内任意单元格时，获取该单元格所在行B列（B4及以下）的姓名、所在列第3行（C3及以下）的城市信息，并将其输出到AN2单元格。

修改后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Const xRg As String = "C4:AK100"
    Dim strOld As String
    Dim strNew As String
    Dim strCmt As String
    Dim strCmt2 As String
    Dim ws As Worksheet
    Dim targetCell As Range
    Dim userName As String
    Dim currentTime As String
    Dim nameInfo As String
    Dim cityInfo As String
    
    Set targetCell = Target(1)
    Set ws = targetCell.Worksheet
    
    ' 检查目标单元格是否在指定区域内
    If Intersect(targetCell, ws.Range(xRg)) Is Nothing Then Exit Sub
    
    ' 获取新旧值
    strNew = targetCell.Text
    Application.EnableEvents = False
    Application.Undo
    strOld = targetCell.Text
    targetCell.Value = strNew
    Application.EnableEvents = True
    
    ' 格式化通用信息
    userName = Application.UserName
    currentTime = Format$(Now, "YYYY/ MM/ DD")
    
    ' 获取姓名（所在行B列）和城市（所在列第3行）
    nameInfo = ws.Cells(targetCell.Row, "B").Value
    cityInfo = ws.Cells(3, targetCell.Column).Value
    ' 输出到AN2单元格
    ws.Range("AN2").Value = "姓名: " & nameInfo & " | 城市: " & cityInfo
    
    ' 处理线程批注
    strCmt = "Updated: " & currentTime & Chr(10) & "By: " & userName & Chr(10) & "Before update : " & strOld
    
    If Not targetCell.CommentThreaded Is Nothing Then
        targetCell.CommentThreaded.Delete
    End If
    targetCell.AddCommentThreaded strCmt
    targetCell.CommentThreaded.Resolved = True
    
    ' 更新AM2和AM3的信息
    strCmt2 = "Updated: " & currentTime & Chr(10) & "By: " & userName & Chr(10)
    ws.Range("AM3").Value = strCmt2
    ws.Range("AM2").Value = Now
    ws.Range("AM2").NumberFormat = "YYYY-MM-DD"
End Sub

关键修改说明 #

1. 关联信息获取与输出：
   • 通过ws.Cells(targetCell.Row, "B").Value提取目标单元格所在行B列的姓名
   • 通过ws.Cells(3, targetCell.Column).Value提取目标单元格所在列第3行的城市
   • 将拼接后的信息直接写入AN2单元格
2. 修复原宏问题：
   • 修正批注文本中的拼写错误Uppdated为Updated
   • 移除未使用的冗余变量，简化代码结构
   • 统一使用targetCell变量替代重复的Target(1)，提升代码可读性
   • 修复Else分支中strCmt2未定义的逻辑漏洞
3. 优化批注处理：
   • 统一先删除原有批注再添加新批注，避免重复判断的冗余逻辑

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