根据列文本突出显示单元格值

时间:2018-05-30 17:23:36

标签: excel vba excel-vba

我有一张excel表,有3000行,F列到BQ。我想强调具有值> gt的特定单元格。 0,其中F列中的文本包含“X”。我该如何为它编写VBA宏?

我尝试了以下代码,但我没有成功:

Sub ConCol()
Set iRow = Range("F2:BQ3000")

For Each cell In iRow
  If cell.Value <> "" And Columns("$F") = "X" Then
cell.Interior.Color = RGB(255, 105, 108)
End If
Next
End Sub

3 个答案:

答案 0 :(得分:1)

试试这段代码,它在我身边工作得很好。 如果列F包含X,我也会突出显示包含X的行中的所有单元格。

Sub ConCol()

'loop on each row
For i = 1 To 3000 ' row

    If InStr(1, ActiveSheet.Cells(i, 6).Value, "X") > 0 Then ' first condition : if col F contain X
        'loop on each column BQ = 69
        For j = 1 To 69

        If InStr(1, ActiveSheet.Cells(i, j).Value, "x") > 0 Then 'second condition : in each cell a selected row, if contain X
        ActiveSheet.Cells(i, j).Interior.Color = RGB(255, 105, 108)
        End If

        Next j

    End If

Next i

End Sub

或者这个版本,我只重点列F:

Sub ConCol2()

'loop on each row
For i = 1 To 3000 ' row

    If InStr(1, ActiveSheet.Cells(i, 6).Value, "X") > 0 Then

        ActiveSheet.Cells(i, 6).Interior.Color = RGB(255, 105, 108)

    End If

Next i

End Sub

答案 1 :(得分:0)

这不是优化的,而是在范围内的行F列中查找大写的“X”。如果存在,它继续查看其他列中的每个单元格以及Isnumeric和&gt; 0它变色了。

Option Explicit

Public Sub ConCol()
    Application.ScreenUpdating = False
    Dim currentRow As Range, loopRange As Range, currentCell As Range

    With ActiveSheet

        Set loopRange = .Range("F2:BQ3000")

        For Each currentRow In loopRange.Rows
            If InStr(1, currentRow.Columns(1).Value, "X", vbBinaryCompare) > 0 Then
                For Each currentCell In currentRow.Cells
                    If IsNumeric(currentCell.Value) And currentCell > 0 Then
                        currentCell.Interior.Color = RGB(255, 105, 108)
                    End If
                Next currentCell
            End If
        Next

    End With

    Application.ScreenUpdating = True

End Sub

答案 2 :(得分:0)

会有以下几种变化:

Sub Button2_Click()
    Dim LstRw As Long, Rng As Range, Sh As Worksheet, c As Range

    Set Sh = ActiveSheet
    With Sh
        LstRw = .Cells(.Rows.Count, "F").End(xlUp).Row
        Set Rng = .Range("G2:BQ" & LstRw)
        For Each c In Rng.SpecialCells(xlCellTypeConstants, 1)
            If c > 0 Then
                If InStr(UCase(.Cells(c.Row, "F")), "X") Then
                    c.Interior.Color = RGB(255, 105, 108)
                End If
            End If
        Next c
    End With

End Sub