Excel VBA邮件生成脚本遍历数据末尾时出错问题排查

问题根源 #

原脚本错误在于未正确限定数据的有效范围，直接逐行遍历直到遇到空单元格，当处理到最后一行数据后的空白单元格时，会因尝试读取空值或执行匹配操作触发错误。

修复方案 #

核心是先精准获取A列的有效数据区域，提取唯一值后再批量处理，彻底避免遍历到空白行：

步骤1：定位有效数据边界 #

用End(xlUp)定位A列最后一行有数据的单元格，确保只处理有内容的行。

步骤2：提取唯一值集合 #

借助字典（Dictionary）自动去重，存储A列的唯一名称，避免重复处理。

步骤3：安全生成邮件内容 #

针对每个唯一值，筛选对应行的E列内容并整理为列表，全程跳过空单元格。

修改后的完整代码 #

Sub SendEmailsByUniqueName()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim nameDict As Object
    Dim cell As Range
    Dim uniqueName As Variant
    Dim emailBody As String
    Dim olApp As Object
    Dim olMail As Object
    
    ' 指定目标工作表，根据实际表名修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取A列最后一行有数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 创建字典存储唯一名称
    Set nameDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历A列有效数据，填充唯一值字典
    For Each cell In ws.Range("A2:A" & lastRow) ' 假设第一行是表头，从第2行开始
        If Trim(cell.Value) <> "" Then ' 跳过中间的空白单元格
            If Not nameDict.Exists(cell.Value) Then
                nameDict.Add cell.Value, cell.Value
            End If
        End If
    Next cell
    
    ' 初始化Outlook应用
    Set olApp = CreateObject("Outlook.Application")
    
    ' 遍历每个唯一名称，生成对应邮件
    For Each uniqueName In nameDict.Keys
        emailBody = "以下是" & uniqueName & "的相关内容：" & vbCrLf & vbCrLf
        
        ' 收集对应行的E列内容
        For Each cell In ws.Range("A2:A" & lastRow)
            If cell.Value = uniqueName Then
                If Trim(ws.Cells(cell.Row, "E").Value) <> "" Then
                    emailBody = emailBody & "- " & ws.Cells(cell.Row, "E").Value & vbCrLf
                End If
            End If
        Next cell
        
        ' 创建并设置邮件
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = "" ' 请填写收件人邮箱
            .Subject = "[" & uniqueName & "] 相关内容汇总"
            .Body = emailBody
            .Display ' 如需直接发送，替换为 .Send
        End With
        
        Set olMail = Nothing
    Next uniqueName
    
    ' 释放对象，避免内存泄漏
    Set olApp = Nothing
    Set nameDict = Nothing
    Set ws = Nothing
    
    MsgBox "邮件处理完成！", vbInformation
End Sub

关键修改说明 #

• 精准限定数据范围：用lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row锁定A列有效数据的最后一行，彻底杜绝遍历空白区域。
• 字典自动去重：利用Scripting.Dictionary的唯一性存储名称，同时跳过A列中间的空白单元格。
• 空值校验：读取单元格内容前增加Trim(cell.Value) <> ""判断，避免空内容导致的逻辑错误。
• 对象及时释放：使用完Outlook、字典等对象后立即释放，减少内存占用。

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