如何修改VBA代码，基于命名列表删除不符合条件的行？

你可以通过Excel的Application.Match函数替代硬编码的多条件判断，直接检查单元格值是否存在于命名列表ReferenceLocations中。后续只需维护这个命名列表，不用修改代码就能适配地点的扩充。

修改后的完整代码 #

Sub DeleteRows()
    ' Defines variables
    Dim cRange As Range, LastRow As Long, x As Long
    Dim refRange As Range ' 新增：存储命名列表对应的单元格范围
    
    ' 获取命名列表"ReferenceLocations"的单元格区域
    Set refRange = ThisWorkbook.Names("ReferenceLocations").RefersToRange
    
    ' Defines LastRow as the last row of data based on column C
    LastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
    
    ' Sets check range as C1 to the last row of C（修正原代码注释笔误）
    Set cRange = Sheets("Sheet1").Range("C1:C" & LastRow)
    
    ' 从下往上遍历单元格（避免删除行导致的索引错乱）
    For x = cRange.Cells.Count To 1 Step -1
        With cRange.Cells(x)
            ' 核心修改：判断单元格值是否不在命名列表中
            If IsError(Application.Match(.Value, refRange, 0)) Then
                .EntireRow.Delete
            End If
        End With
    Next x
End Sub

关键修改说明 #

1. 新增变量refRange：指向命名列表ReferenceLocations对应的单元格区域，后续直接通过该变量调用列表内容。
2. 替换If判断逻辑：
   • Application.Match(.Value, refRange, 0)会在命名列表中查找当前单元格的值，找到则返回对应位置序号，找不到则返回错误值。
   • IsError(...)捕获错误结果，当结果为True时，说明单元格值不在列表中，执行删除行操作。

注意事项 #

• 确保命名列表ReferenceLocations已在Excel中正确定义（可通过「公式」选项卡→「名称管理器」查看/维护）。
• 若命名列表位于其他工作表，代码依然能正常识别，无需额外修改。
• 若需要保留空值行，可修改判断条件为：If Not IsEmpty(.Value) And IsError(Application.Match(.Value, refRange, 0)) Then

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