Excel VBA插入多组筛选Range到邮件时内容重复如何解决？

• Range对象为动态引用：你声明的Table1、table2都是指向工作表单元格区域的动态引用，而非静态的内容快照。你在定义完Table1后修改了筛选规则、列隐藏状态，Table1指向的区域内容会同步更新为第二次筛选后的结果，最终两个Range转HTML时取的都是最终状态下的区域内容，所以会一致或高度相似。
• With块引用不规范：在With Sheets("Accepted Followup")代码块中，你使用的Cells(1, 1)没有加.前缀，实际引用的是当前活动工作表的单元格，而非With块指定的工作表，容易出现引用错位的问题。

核心逻辑：每次筛选完成后立刻将当前Range转为HTML字符串存储，不要等到所有筛选操作完成后再统一转换，即可保留不同筛选状态下的表格内容。同时修复代码中的不规范写法避免其他报错。

Sub Emailrange()
    Dim OutApp As Object
    Dim OutMail As Object
    ' 注意VBA中每行单独声明变量类型，否则未指定类型的变量默认是Variant
    Dim count_row As Integer, count_col As Integer
    Dim Table1 As Range, table2 As Range
    Dim str1 As String, str2 As String, str3 As String
    ' 新增两个字符串变量存储静态HTML内容
    Dim strTable1 As String, strTable2 As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    ' 第一组筛选
    Selection.AutoFilter
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Range("G1").Select
    Selection.AutoFilter
        
    Selection.Delete Shift:=xlToLeft
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=9, Criteria1:="API"
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=7, Criteria1:="=BLOQUEO VT", Operator:=xlOr, Criteria2:="="
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=4, Criteria1:="Luch"
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=6, Criteria1:="#N/A"
    Selection.EntireColumn.Hidden = True
    
    ' 定义Table1并立刻转成HTML存储
    With Sheets("Accepted Followup")
        count_row = WorksheetFunction.CountA(.Range("A1", .Range("A1").End(xlDown)))
        count_col = WorksheetFunction.CountA(.Range("A1", .Range("A1").End(xlToRight)))
        ' 加.前缀确保引用的是With块指定的工作表
        Set Table1 = .Range(.Cells(1, 1), .Cells(count_row, count_col))
    End With
    strTable1 = RangetoHTML(Table1)

    ' 第二组筛选
    Selection.AutoFilter
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Range("G1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=7, Criteria1:= _
    "=BLOQUEO VT", Operator:=xlOr, Criteria2:="="
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=6, Criteria1:="True"
    ActiveWindow.SmallScroll ToRight:=0
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=8, Criteria1:="Aceptado"
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=10, Criteria1:="="
    ActiveSheet.Range("$A$1:$N$390").AutoFilter Field:=4, Criteria1:="Luch"
    Columns("G:CB").Select
    Selection.EntireColumn.Hidden = True

    ' 定义table2并立刻转成HTML存储
    With Sheets("Accepted Followup")
        count_row = WorksheetFunction.CountA(.Range("A1", .Range("A1").End(xlDown)))
        count_col = WorksheetFunction.CountA(.Range("A1", .Range("A1").End(xlToRight)))
        Set table2 = .Range(.Cells(1, 1), .Cells(count_row, count_col))
    End With
    strTable2 = RangetoHTML(table2)

    ' 拼接邮件内容
    str1 = "<BODY STYLE = font-size:12pt;font-family:Calibri>" & "Good morning,<br>"
    str2 = "<br>Please see below.<br>"
    str3 = "<br>Best regards."

    On Error Resume Next
    With OutMail
        .to = "rudy@lucian.es"
        .CC = ""
        .Subject = "Tables"
        .Display
        ' 直接使用提前存储好的静态HTML字符串
        .HTMLBody = str1 & str2 & strTable2 & strTable1 & "<br> <br>" & str3 & .HTMLBody
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

如果你的工程中还没有RangetoHTML自定义函数，补充以下通用实现即可：

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    TempWB.Close savechanges:=False

    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

内容的提问来源于stack exchange，提问作者Marta letón