Excel VBA中VLOOKUP返回FALSE及按条件批量发邮件问题

核心问题修复点 #

• VLOOKUP返回错误问题：原有函数混淆了公式赋值和结果取值逻辑，且错误依赖ActiveCell（遍历过程中ActiveCell不会跟随循环变量变动），同时RC偏移参数计算错误、查询范围写死。改用VBA内置的WorksheetFunction.VLookup直接计算结果，所有查询范围动态取最后一行。
• A列重复值避免重复发邮件：引入字典对象存储已处理的A列值，遍历前判断当前值是否已在字典中，存在则跳过本次循环。
• 动态范围适配每周数据变动：所有工作表的查询范围都通过End(xlUp)方法动态获取最后一行，不写死行号限制。

修正后完整代码 #

Sub manda_email()
    Dim cc_padrao As String
    Dim Lastrow As Long, band_lastrow As Long
    Dim lj As Range
    Dim OutApp As Object, OutMail As Object
    Dim saudacao As String, corpo As String, dif As String, final_str As String
    ' 字典用于存储已处理的A列唯一值
    Dim processed_lojas As Object
    Set processed_lojas = CreateObject("Scripting.Dictionary")
    
    Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    cc_padrao = "Carlos@email; Son@email; Lau@email"
    
    ' 动态获取Bandeiras表的最后一行，不写死范围
    band_lastrow = Sheets("Bandeiras").Cells(Rows.Count, 1).End(xlUp).Row
    ' 填充F列的分类值，不用Select操作提升效率
    Range("F2:F" & Lastrow).FormulaR1C1 = "=VLOOKUP(RC[-5],Bandeiras!R2C1:R" & band_lastrow & "C2,2,0)"
    
    Set OutApp = CreateObject("Outlook.Application")
       
    For Each lj In Range("A2:A" & Lastrow)
        ' 跳过已处理的店铺，避免重复发邮件
        If processed_lojas.exists(lj.Value) Then GoTo next_lj
        
        Dim band_type As String
        ' 直接取当前行F列的值，不用End(xlToRight)避免判断错误
        band_type = lj.Offset(0, 5).Value
        
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .display
            If band_type = "Elt" Then
                .To = GR_Elt(lj.Value)
                .cc = cc_padrao & ";" & CR_Elt(lj.Value)
                .Subject = "Dif | Eletro" & lj.Value
            Else
                .To = GR_Bt(lj.Value) & ";" & EN_Bt(lj.Value)
                .cc = cc_padrao & ";" & CR_Bt(lj.Value)
                .Subject = "Dif | BT" & lj.Value
            End If
            
            saudacao = "Olá, " & Chr(10) & Chr(10)
            corpo = "Por gentileza, " & Chr(10) & Chr(10)
            dif = "Incluir tabela" & Chr(10) & Chr(10)
            final_str = "Por gentileza, enviar." & Chr(10) & Chr(10) & "Aguardo breve retorno." & Chr(10) & Chr(10)
            .BODY = saudacao & corpo & dif & final_str
            
            ' 测试完成后取消注释即可自动发送
            '.Send
        End With
        ' 把当前店铺加入已处理字典
        processed_lojas.Add lj.Value, True
next_lj:
    Next
    ' 释放对象
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set processed_lojas = Nothing
End Sub

' 传入店铺名称查询对应联系人，避免依赖ActiveCell
Public Function GR_Elt(loja_name As String) As String
    On Error Resume Next
    Dim last_row As Long
    last_row = Sheets("Contatos Elt").Cells(Rows.Count, 1).End(xlUp).Row
    GR_Elt = WorksheetFunction.VLookup(loja_name, Sheets("Contatos Elt").Range("A1:D" & last_row), 4, 0)
    If Err.Number <> 0 Then GR_Elt = ""
    On Error GoTo 0
End Function

Public Function GR_Bt(loja_name As String) As String
    On Error Resume Next
    Dim last_row As Long
    last_row = Sheets("Contatos Bt").Cells(Rows.Count, 1).End(xlUp).Row
    GR_Bt = WorksheetFunction.VLookup(loja_name, Sheets("Contatos Bt").Range("A1:C" & last_row), 3, 0)
    If Err.Number <> 0 Then GR_Bt = ""
    On Error GoTo 0
End Function

Public Function CR_Elt(loja_name As String) As String
    On Error Resume Next
    Dim last_row As Long
    last_row = Sheets("Contatos Elt").Cells(Rows.Count, 1).End(xlUp).Row
    CR_Elt = WorksheetFunction.VLookup(loja_name, Sheets("Contatos Elt").Range("A1:F" & last_row), 6, 0)
    If Err.Number <> 0 Then CR_Elt = ""
    On Error GoTo 0
End Function

Public Function CR_Bt(loja_name As String) As String
    On Error Resume Next
    Dim last_row As Long
    last_row = Sheets("Contatos Bt").Cells(Rows.Count, 1).End(xlUp).Row
    CR_Bt = WorksheetFunction.VLookup(loja_name, Sheets("Contatos Bt").Range("A1:E" & last_row), 5, 0)
    If Err.Number <> 0 Then CR_Bt = ""
    On Error GoTo 0
End Function

Public Function EN_Bt(loja_name As String) As String
    On Error Resume Next
    Dim last_row As Long
    last_row = Sheets("Contatos Bt").Cells(Rows.Count, 1).End(xlUp).Row
    EN_Bt = WorksheetFunction.VLookup(loja_name, Sheets("Contatos Bt").Range("A1:D" & last_row), 4, 0)
    If Err.Number <> 0 Then EN_Bt = ""
    On Error GoTo 0
End Function

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