Excel VBA需求：实现R列单元格变更时自动发送对应行O/Q列内容邮件

原代码仅能监控R30单元格变更并发送对应邮件，要扩展到R31及以下任意行变更时触发邮件，修复后代码及说明如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 定义监控范围：R列从第30行开始的所有单元格
    Dim monitorRange As Range
    Set monitorRange = Me.Range("R30:R" & Me.Rows.Count)
    
    ' 检查变更单元格是否在监控范围内
    If Not Intersect(Target, monitorRange) Is Nothing Then
        Dim OutlookApp As Object
        Dim OutlookEmail As Object
        Dim cell As Range
        
        ' 关闭事件触发，避免邮件发送时的循环触发
        Application.EnableEvents = False
        
        On Error GoTo Cleanup ' 错误处理，确保对象能被释放
        
        Set OutlookApp = CreateObject("Outlook.Application")
        
        ' 遍历所有变更的单元格（支持批量修改）
        For Each cell In Intersect(Target, monitorRange)
            Set OutlookEmail = OutlookApp.CreateItem(0) ' 后期绑定用0代替olMailItem常量
            
            With OutlookEmail
                .To = "xxx@yahoo.com" ' 替换为收件人邮箱
                .Subject = "Excel 单元格 R" & cell.Row & " 已变更"
                .Body = "单元格 R" & cell.Row & " 的当前值为：" & cell.Value & vbCrLf & _
                        "对应行 O" & cell.Row & " 的值为：" & Me.Range("O" & cell.Row).Value & vbCrLf & _
                        "对应行 Q" & cell.Row & " 的值为：" & Me.Range("Q" & cell.Row).Value
                .Send
            End With
            
            Set OutlookEmail = Nothing
        Next cell
        
Cleanup:
        ' 释放对象并恢复事件触发
        Set OutlookApp = Nothing
        Application.EnableEvents = True
        
        ' 如果有错误，抛出提示
        If Err.Number <> 0 Then
            MsgBox "邮件发送失败：" & Err.Description, vbExclamation
        End If
    End If
End Sub

关键修改说明 #

• 监控范围扩展：将原固定的Range("R30")改为R30:R[最后一行]，覆盖R列30行及以后所有单元格
• 支持批量变更：遍历所有变更的单元格，避免一次修改多个R列单元格时只处理第一个
• 动态行引用：用cell.Row获取当前变更单元格的行号，动态拼接O、Q、R列的单元格地址，适配任意行
• 后期绑定兼容：用数值0代替olMailItem常量（后期绑定未定义该常量，原代码可能因此报错）
• 错误处理与事件保护：添加Application.EnableEvents = False避免邮件发送时触发循环变更，同时确保任何情况下都能释放对象、恢复事件触发

内容的提问来源于stack exchange，提问作者Cik Kiah Cirit