VBA实现筛选区域XLOOKUP填充功能代码求助

原代码的问题 #

原代码仅处理了第一个筛选出的TBD行，无法批量替换所有符合条件的单元格；同时缺少无匹配结果时的错误处理，可能导致运行报错。

完善后的代码 #

Sub ReplaceTBDWithXLookup()
    Dim wsNew As Worksheet, wsOld As Worksheet
    Dim endRowOld As Long
    Dim visibleRange As Range, cell As Range
    
    ' 初始化工作表对象，简化后续代码
    Set wsNew = ThisWorkbook.Worksheets("New TS")
    Set wsOld = ThisWorkbook.Worksheets("Old TS")
    
    ' 取消之前的筛选（防止已有筛选影响结果）
    If wsNew.AutoFilterMode Then wsNew.AutoFilterMode = False
    
    ' 获取Old TS表G列最后一行（动态行）
    endRowOld = wsOld.Range("G" & wsOld.Rows.Count).End(xlUp).Row
    
    ' 筛选New TS表H列的"TBD"值
    wsNew.Range("1:1").AutoFilter Field:=8, Criteria1:="TBD"
    
    On Error Resume Next ' 处理无可见单元格的情况
    ' 获取H列中筛选后的可见单元格（跳过表头，从第2行开始）
    Set visibleRange = wsNew.Range("H2:H" & wsNew.Rows.Count).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 如果存在符合条件的单元格，循环处理每一行
    If Not visibleRange Is Nothing Then
        For Each cell In visibleRange
            ' 应用XLOOKUP，匹配当前行C、E列与Old TS的C、E列，返回G列值
            cell.Value = Application.XLookup( _
                1, _
                (wsNew.Cells(cell.Row, 3) = wsOld.Range("C2:C" & endRowOld)) * _
                (wsNew.Cells(cell.Row, 5) = wsOld.Range("E2:E" & endRowOld)), _
                wsOld.Range("G2:G" & endRowOld), _
                "TBD", _
                0 _
            )
        Next cell
    End If
    
    ' 取消筛选，恢复表格显示
    wsNew.AutoFilterMode = False
End Sub

关键改进点 #

• 批量处理：通过For Each循环遍历所有筛选出的TBD单元格，替换每一行的值
• 错误处理：添加On Error语句，避免无TBD值时SpecialCells方法报错
• 代码简化：声明工作表对象，减少重复代码，提升可读性
• 状态恢复：执行完成后自动取消筛选，保持表格整洁

内容的提问来源于stack exchange，提问作者Viktória Bernád