VBA技术需求：自动选中A列含x的行指定区域并合并邮件发送

我懂你的痛点——原来的代码每次循环都会覆盖选中的区域，最后就只剩最后一行符合条件的B-D列被选中，根本没法合并所有目标数据发邮件。咱们来调整代码，用Union方法把所有符合条件的区域合并起来，这样就能一次性选中所有需要的行啦！

原代码的问题所在 #

你原来的代码里，每次循环到符合条件的行时，都会执行Set r1 = Range(Cells(i, 2), Cells(i, 4))，这相当于把r1重新赋值成当前行的区域，之前找到的区域都被覆盖了，所以最后只会保留最后一行的内容。

修正后的代码 #

下面是调整后的代码，我加了详细注释，方便你理解：

Sub Button3_Click()
    Dim lRow As Long ' 用Long替代Integer，避免行数过多时溢出
    Dim i As Long
    Dim ws As Worksheet ' 明确指定工作表，防止活动表切换导致错误
    Dim r1 As Range
    Dim currentRange As Range ' 存储当前符合条件的单行区域
    
    ' 替换成你的目标工作表名称，比如"Sheet1"
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取B列最后一行的行号（保留你原代码的判断逻辑）
    lRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    
    ' 初始化合并区域为Nothing，方便后续判断是否有符合条件的行
    Set r1 = Nothing
    
    For i = 2 To lRow
        ' 检查A列当前行是否为"x"
        If ws.Cells(i, 1).Value = "x" Then
            ' 定义当前行的B到D列区域
            Set currentRange = ws.Range(ws.Cells(i, 2), ws.Cells(i, 4))
            
            ' 如果是第一个符合条件的区域，直接赋值给r1；否则合并到已有区域
            If r1 Is Nothing Then
                Set r1 = currentRange
            Else
                Set r1 = Union(r1, currentRange)
            End If
            
            ' 在J列标记选中状态和时间
            ws.Cells(i, 10).Value = "Selected " & Now() ' Now()直接返回日期+时间，更简洁
        End If
    Next i
    
    ' 如果找到符合条件的区域，就选中它；否则提示用户
    If Not r1 Is Nothing Then
        r1.Select
    Else
        MsgBox "没有找到A列值为""x""的行，请检查数据！"
    End If
    
    ThisWorkbook.Save
End Sub

关键修改说明 #

• 明确指定工作表：避免因为当前活动表不是目标表而导致错误，你需要把"Sheet1"改成你实际使用的工作表名称。
• 使用Union合并区域：这是核心！它能把多个不连续的区域合并成一个Range对象，这样最后r1就包含了所有A列为"x"的行的B-D列区域。
• 用Long存储行号：Excel的行数最多能到1048576，Integer的最大值是32767，用Long可以避免溢出问题。
• 增加无匹配提示：如果没有找到任何A列为"x"的行，会弹出提示框，避免用户误以为代码没运行。

额外小建议 #

其实后续转HTML的时候，不需要选中区域，直接用r1对象就可以生成HTML内容，比如可以用r1.HTMLFragment（需要引用Microsoft Excel Object Library），这样代码效率更高，也不会干扰用户的操作。

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