VBA如何选中蓝色高亮且F列为空的行并复制到新工作表

问题排查 #

• 工作表引用混乱：代码同时引用Sheet10和ActiveSheet，如果当前激活的工作表不是Sheet10，判断逻辑会完全错位，条件匹配失效
• 冗余嵌套循环：外层已经遍历所有行i，内层又加了无意义的n循环，不仅拖慢执行速度，还会导致逻辑重复执行，甚至出现长时间卡顿假死的情况
• 变量声明不规范：Dim i, n As Long写法中只有n是Long类型，i默认是Variant类型，虽然不直接报错但存在隐式类型转换风险
• 空值判断逻辑不严谨：直接用.Item(i) = ""判断无法识别单元格内的不可见空格、公式返回空值等情况，建议用IsEmpty或者WorksheetFunction.CountBlank判断

修正后代码（包含验证高亮+复制到新表完整逻辑） #

Sub 筛选符合条件行()
    Dim LastRowS1 As Long, i As Long, nextRow As Long
    Dim targetSheet As Worksheet, newSheet As Worksheet
    
    ' 明确指定操作的工作表为Sheet10，避免ActiveSheet带来的引用错误
    Set targetSheet = Sheet10
    ' 创建新工作表存放结果
    Set newSheet = ThisWorkbook.Worksheets.Add(After:=targetSheet)
    newSheet.Name = "筛选结果_" & Format(Now(), "YYYYMMDDHHMMSS")
    
    LastRowS1 = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    For i = LastRowS1 To 1 Step -1
        ' 同时满足两个条件：A列高亮为蓝色、F列为空
        If targetSheet.Range("A" & i).DisplayFormat.Interior.Color = vbBlue _
        And IsEmpty(targetSheet.Range("F" & i).Value) Then
            ' 验证逻辑：整行标绿
            targetSheet.Rows(i).Interior.Color = vbGreen
            ' 复制到新工作表
            nextRow = newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Row + 1
            targetSheet.Rows(i).Copy newSheet.Rows(nextRow)
        End If
    Next i
    
    ' 释放对象
    Set targetSheet = Nothing
    Set newSheet = Nothing
    MsgBox "处理完成，结果已保存到新工作表：" & newSheet.Name
End Sub

注意事项 #

• 如果你的蓝色不是系统默认的vbBlue常量对应的颜色，需要先取到对应蓝色的RGB值，替换vbBlue为RGB(红值,绿值,蓝值)即可
• 如果不需要保留原表的绿色高亮验证，删除targetSheet.Rows(i).Interior.Color = vbGreen这一行即可

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