VBA遍历值并过滤问题：仅生成首个匹配值邮件求助

首先，我发现你的代码里有几个关键问题导致只能处理第一个值：

• Selection对象指向错误：在创建DupRemoved工作表并去重后，你的For Each Cll In Selection其实是在遍历RawData的A列（因为最后一次Select操作是在RawData里选A列），而不是去重后的DupRemoved数据。
• 冗余的工作表切换：频繁使用Select/Activate不仅降低效率，还容易导致逻辑混乱，因为VBA会依赖当前激活的工作表。
• 循环内的重复操作：每次循环都清空FilteredData、重复切换工作表，会覆盖之前的结果，也容易出错。

下面是修复后的代码，我会保留你的核心逻辑，同时优化这些问题：

Sub Macro1()
    Dim wsRaw As Worksheet, wsDupRemoved As Worksheet
    Dim wsFiltered As Worksheet, wsMail As Worksheet, wsSheet1 As Worksheet, wsHome As Worksheet
    Dim lastRow As Long, dupLastRow As Long
    Dim cell As Range
    Dim oppValue As Variant
    
    ' 提前定义所有工作表，避免Select/Activate
    Set wsRaw = ThisWorkbook.Sheets("RawData")
    Set wsSheet1 = ThisWorkbook.Sheets("Sheet1")
    Set wsFiltered = ThisWorkbook.Sheets("FilteredData")
    Set wsMail = ThisWorkbook.Sheets("Mail")
    Set wsHome = ThisWorkbook.Sheets("Home")
    
    ' 创建并处理DupRemoved工作表（处理已存在的情况）
    On Error Resume Next
    Set wsDupRemoved = ThisWorkbook.Sheets("DupRemoved")
    If Err.Number <> 0 Then
        Set wsDupRemoved = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsDupRemoved.Name = "DupRemoved"
    End If
    On Error GoTo 0
    
    ' 复制RawData的A列到DupRemoved并去重
    wsRaw.Columns("A:A").Copy Destination:=wsDupRemoved.Range("A1")
    wsDupRemoved.Range("$A$1:$A$1000").RemoveDuplicates Columns:=1, Header:=xlYes
    
    ' 获取DupRemoved中去重后的最后一行
    dupLastRow = wsDupRemoved.Cells(wsDupRemoved.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历DupRemoved中A列的所有数据（跳过表头，从A2开始）
    For Each cell In wsDupRemoved.Range("A2:A" & dupLastRow)
        oppValue = wsSheet1.Range("Opp").Value
        
        ' 如果当前单元格值小于0，替换为Opp值
        If cell.Value < 0 Then
            cell.Value = oppValue
        End If
        
        ' 清空FilteredData的内容
        wsFiltered.Range("$A$2:$S$1224").ClearContents
        
        ' 在RawData中筛选当前cell的值
        wsRaw.Range("$A$1:$S$1224").AutoFilter Field:=1, Criteria1:=cell.Value
        
        ' 复制筛选后的结果到FilteredData（仅复制值）
        wsRaw.Range("$A$1:$S$1224").SpecialCells(xlCellTypeVisible).Copy
        wsFiltered.Range("A1").PasteSpecial Paste:=xlPasteValues
        
        ' 在Mail工作表中执行筛选
        wsMail.Range("$A$1:$S$1224").AutoFilter Field:=1, Criteria1:=cell.Value
        
        ' 显示RawData的所有数据
        wsRaw.ShowAllData
        
        ' 调用Macro2生成当前值对应的邮件
        Call Macro2
    Next cell
    
    ' 回到Home工作表
    wsHome.Activate
    Application.CutCopyMode = False ' 清除复制模式
End Sub

关键改进点： #

1. 避免Select/Activate：直接通过工作表对象引用，比如wsRaw.Columns("A:A").Copy，这样不会依赖当前激活的工作表，逻辑更清晰，也更稳定。
2. 正确遍历去重后的数据：明确指定遍历wsDupRemoved.Range("A2:A" & dupLastRow)，也就是去重后的A列数据（跳过表头），确保每个值都被处理。
3. 错误处理：增加了On Error Resume Next来处理DupRemoved工作表已存在的情况，避免重复创建报错。
4. 优化复制逻辑：使用SpecialCells(xlCellTypeVisible)直接复制筛选后的可见区域，不需要手动选择行。
5. 循环内调用Macro2：确保每个值处理完成后都调用Macro2生成邮件，而不是只在循环结束后调用一次。

这样修改后，代码应该会遍历所有去重后的值，并为每个值生成对应的邮件了。

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