根据另一个单元格的内容格式化特定单元格

问题描述 投票:0回答:2

我找到了代码并尝试合并它。

我明白了

运行时错误'9'下标超出范围

当我满足我的标准时,如果单元格 b1 =“TOTAL”,那么我想查看相应的单元格 c1 并确定它是否小于 8000。
如果是,我想将其突出显示为绿色。
如果超过 8000 我想将其突出显示为红色。
如果 b1 不是“TOTAL”,我想转到下一行并对 c1 不执行任何操作。

数据:
enter image description here

Dim i As Long
Dim LastRow As Long
Dim wS As Worksheet

Set wS = ThisWorkbook.Sheets("Gateway")
LastRow = LastRow_1(wS)
For i = 1 To LastRow
    With wS
        If .Cells(i, 2) = "TOTAL" And .Cells(i, 3) < 8000 Then
            .Cells(i, 3).FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            With Selection.FormatConditions(1).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
            With .Cells(i, 3).FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
            End With
            Selection.FormatConditions(1).StopIfTrue = False
        Else
            'B and C empty
            '.Cells(i, 3) format red
        End If
    End With 'wS
Next i

End Sub


Public Function LastRow_1(wS As Worksheet) As Double

    With wS
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow_1 = .Cells.Find(What:="*", _
                                After:=.Range("c1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Row
        Else
            LastRow_1 = 1
        End If
    End With
    
End Function
excel vba formatting conditional-formatting
2个回答
0
投票

尝试下面修改后的代码(代码中的注释)。

注意 - 不确定您是否打算对整个 B 列和 C 列运行循环,或者只是对单个单元格运行。

Option Explicit

Sub ColorCellC1()

Dim i As Long, LastRow As Long
Dim wS As Worksheet

Set wS = ThisWorkbook.Sheets("Gateway")
LastRow = FindLastRow(wS)

If LastRow = 0 Then ' if worksheet "Gateway" does not conatin any data
    Exit Sub
End If

For i = 1 To LastRow
    With wS
        If .Range("B" & i).Value = "TOTAL" Then
            If .Range("C" & i).Value < 8000 Then
                .Range("C" & i).Interior.Color = vbGreen
            Else
                .Range("C" & i).Interior.Color = vbRed
            End If
        
        Else
            ' do Nothing
        End If
    End With 'wS
Next i

End Sub


Function FindLastRow(Sht As Worksheet) As Long

' This Function finds the last row in a worksheet, and returns the row number

Dim LastCell As Range

With Sht
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), LookAt:=xlPart, LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then
        FindLastRow = LastCell.Row
    Else
        FindLastRow = 0
    End If
End With

End Function

0
投票

您可能不需要函数来获取最后一行#。我不确定条件格式是否是必须的。提供的代码用填充颜色突出显示单元格。

Sub Demo()
    Dim i As Long
    Dim LastRow As Long
    Dim wS As Worksheet
    Set wS = ThisWorkbook.Sheets("Gateway")
    LastRow = wS.Cells(ws.Rows.Count, 2).End(xlUp).Row
    For i = 1 To LastRow
        With wS
            If .Cells(i, 2) = "TOTAL" And .Cells(i, 3) <> "" Then
                If .Cells(i, 3) < 8000 Then
                    .Cells(i, 3).Interior.Color = vbGreen
                Else
                    .Cells(i, 3).Interior.Color = vbRed
                End If
            End If
        End With
    Next
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.