突出显示等于单元格foobar中的值的所有行

时间:2015-09-04 17:35:37

标签: excel vba excel-vba excel-2007

我正在尝试编写此过程以突出显示其中所有行在列N中的相应行中具有值“N”的行

我不太熟悉编码VBA格式,我无法让这个程序运行

Sub highlight_new_pos()

Dim rng As Range, lCount As Long, LastRow As Long
Dim cell As Object

With ActiveSheet    'set this worksheet properly!
    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For Each cell In .Range("N2:N" & LastRow)
        If cell = "N" Then
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With

    Next cell
End With


End Sub

2 个答案:

答案 0 :(得分:1)

在你的代码中,你循环遍历单元格,但是你仍然在改变初始选择的颜色(而不是循环中单元格的颜色)。调整如下:

Sub highlight_new_pos()

Dim rng As Range, lCount As Long, LastRow As Long
Dim cell As Object

With ActiveSheet    'set this worksheet properly!
    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For Each cell In .Range("N2:N" & LastRow)
        If cell = "N" Then
            With cell.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End if
    Next cell
End With


End Sub

如果您想要整行,请将cell.Interior更改为cell.entirerow.Interior

答案 1 :(得分:1)

Option Explicit

Sub highlight_new_pos()
    Dim cel As Object

    With ActiveSheet
        For Each cel In .Range("N2:N" & .Cells(.Rows.Count, 14).End(xlUp).Row)
            If UCase(cel.Value2) = "N" Then cel.Interior.Color = 65535
        Next
    End With
End Sub

如果你有很多行,这会更快:

Sub highlight_new_pos1()
    Application.ScreenUpdating = False
    With ActiveSheet
        With .Range("N1:N" & .Cells(.Rows.Count, 14).End(xlUp).Row)
            .AutoFilter Field:=1, Criteria1:="N"
            .Offset(1, 0).Resize(.Rows.Count - 14, .Columns.Count).Interior.Color = 65535
            .AutoFilter
        End With
    End With
    Application.ScreenUpdating = True
End Sub