如何对筛选后的数据执行Vlookup操作及VBA代码报错求助

核心报错原因 #

• For循环起始值语法错误：你在循环起始位置调用了.Select方法，该方法无数值返回，无法作为循环变量X的起始值
• 遍历逻辑错误：开启筛选后直接遍历全量行，会包含筛选隐藏的行，不符合仅处理可见行的需求
• 末行计算逻辑错误：使用End(xlDown)计算末行，若对应列中间存在空值会得到错误的末行号，同时RLastRow&末尾多余的&属于语法笔误
• 代码冗余：两次调用Vlookup做重复匹配，可合并优化

修复后可运行代码 #

Sub Filter1()
    Dim DataRK As Worksheet, Ref As Worksheet
    Dim RLastRow As Long, DLastRow As Long, visRng As Range, r As Range
    Dim DataRng As Range, DataRng1 As Range
    Dim MatchResult
    
    Application.ScreenUpdating = False
    
    ' 绑定工作表对象
    Set DataRK = ThisWorkbook.Worksheets("Open")
    Set Ref = ThisWorkbook.Worksheets("Reference")
    
    ' 修正末行计算逻辑，改用End(xlUp)避免空行干扰
    DLastRow = DataRK.Range("G" & DataRK.Rows.Count).End(xlUp).Row
    RLastRow = Ref.Range("N" & Ref.Rows.Count).End(xlUp).Row
    
    Set DataRng = DataRK.Range("A1:T" & DLastRow)
    ' 清除原有筛选
    DataRK.AutoFilterMode = False
    ' 执行目标筛选
    DataRng.AutoFilter Field:=5, Criteria1:="=*Freight Invoice*"
    
    ' 定义参考匹配范围，修正笔误
    Set DataRng1 = Ref.Range("N2:O" & RLastRow)
    
    ' 仅提取筛选后的可见行（跳过表头），增加空值容错
    On Error Resume Next
    Set visRng = DataRK.Range("G2:G" & DLastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visRng Is Nothing Then
        For Each r In visRng
            ' 执行匹配
            MatchResult = Application.VLookup(r.Value, DataRng1, 1, False)
            If Not IsError(MatchResult) Then
                ' 匹配成功写入对应结果（G列偏移11列即为R列）
                r.Offset(0, 11).Value = MatchResult
            Else
                ' 匹配失败写入Open
                r.Offset(0, 11).Value = "Open"
                ' 按需开启背景色设置
                ' r.Offset(0, 11).Interior.Color = vbRed
            End If
        Next r
    End If
    
    ' 按需选择执行完是否关闭筛选
    ' DataRK.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

优化说明 #

• 直接遍历筛选后的可见单元格，避免处理隐藏行，运行效率更高
• 移除了无意义的.Select操作，降低出错概率提升运行效率
• 增加了无匹配可见行的容错处理，避免空筛选场景下代码报错

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