基于两列筛选并排序数据的VBA代码未达预期结果求助

原代码核心问题 #

• 匹配逻辑颠倒：先筛选D列类型再找M列城市，但Match会读取隐藏行数据，无法精准定位**同时满足城市（M列）和类型（D列）**的目标区域
• 行范围计算不合理：用j+7固定排序范围，没有依据实际数据行确定边界
• 未处理筛选空结果异常：直接调用SpecialCells会触发运行时错误
• 排序参数冗余：两次Sort调用核心逻辑一致，无需分支判断

修正后的VBA代码 #

Dim ws As Worksheet
Dim lastRow As Long
Dim filterValues As Variant
Dim searchCriteria As Variant
Dim criteria As Variant
Dim filterVal As Variant
Dim criteriaRow As Long
Dim dataStartRow As Long
Dim dataEndRow As Long
Dim sortRange As Range

' 指定目标工作表
Set ws = ActiveWorkbook.Worksheets("MSA 16-286")
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

' 定义筛选类型数组与搜索城市数组
filterValues = Array("Apartments", "Single Family Rental", "Student Housing", "Manufactured Housing", "Senior Housing", "Affordable Housing", "Industrial", "Hospitality", "Retail", "Self Storage")
searchCriteria = Array("Jacksonville, FL", "Houston-The Woodlands-Sugar Land, TX", "Minneapolis-St. Paul-Bloomington, MN-WI")

' 遍历每个目标城市
For Each criteria In searchCriteria
    ' 定位当前城市在M列的首次出现行（从第9行开始匹配）
    criteriaRow = Application.Match(Trim(criteria), ws.Range("M9:M" & lastRow), 0)
    If Not IsError(criteriaRow) Then
        criteriaRow = criteriaRow + 8 ' 转换为工作表实际行号
        
        ' 自动识别当前城市对应的数据区域边界
        dataStartRow = criteriaRow + 1
        On Error Resume Next
        dataEndRow = Application.Match("*", ws.Range("M" & dataStartRow & ":M" & lastRow), 0) + dataStartRow - 2
        On Error GoTo 0
        If dataEndRow < dataStartRow Then dataEndRow = lastRow
        
        ' 遍历每个筛选类型
        For Each filterVal In filterValues
            ' 在当前城市数据范围内筛选D列指定类型
            ws.Range("D" & dataStartRow & ":D" & dataEndRow).AutoFilter Field:=1, Criteria1:=filterVal
            
            ' 定义排序范围（包含表头）
            Set sortRange = ws.Range("A8:I" & dataEndRow)
            
            ' 捕获筛选后可见区域（避免无结果报错）
            On Error Resume Next
            Set sortRange = sortRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            
            ' 按M列降序排序（若需求是按I列，将Key1改为ws.Range("I8:I" & dataEndRow)即可）
            If Not sortRange Is Nothing Then
                sortRange.Sort Key1:=ws.Range("M8:M" & dataEndRow), Order1:=xlDescending, Header:=xlYes, _
                    MatchCase:=False, Orientation:=xlTopToBottom
            End If
            
            ' 清除当前筛选
            ws.AutoFilterMode = False
            Set sortRange = Nothing
        Next filterVal
    End If
Next criteria

' 确保所有筛选完全清除
ws.AutoFilterMode = False

关键修正说明 #

1. 精准锁定城市数据区：找到M列城市行后，自动识别该城市对应的连续数据边界，不再用固定偏移量
2. 先锁城市再筛类型：确保只在当前城市的数据范围内筛选指定类型，避免跨城市干扰
3. 异常防护：添加错误处理，避免筛选无结果时触发报错
4. 简化逻辑：统一排序参数，可按需切换排序列

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