绑定多个条件 IsEmpty Cell.Value 和 Offset

Question

我想突出显示满足一组特定条件的单元格。 D 列到 Q 列之间的所有单元格都是应该影响的范围。

单元格值必须等于 "y"。
S 列中的相邻单元格必须等于 "New row"。 A 列中的相邻单元格必须等于其上方的单元格。例如：A2 = A1、A3 = A2、A4 = A3 等。并且等于 "y" 的单元格上方的单元格必须为空。

我想顺序无关紧要。

请帮忙..

这是我到目前为止所写的内容..

    Sub TestMod()

Dim rng As Range
Dim cell As Range

Set rng = Range("A1:S1000")

For Each cell In rng

If cell.Value = "y" AND IsEmpty(Offset(cell.Value = "y",0,-1)
Then

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
   End If
    Selection.FormatConditions(1).StopIfTrue = False


End Sub

我还附上了我正在使用的电子表格。

Attachment

Answer 1

我提出 "not-conditional formatting" 方法如下：

Option Explicit

Sub Main()
    Dim cell As Range, newRowRng As Range, myRow As Range, f As Range
    Dim firstAddress As String

    With Sheets("myDataSheetName") '<--| change "myDataSheetName" to your actual sheet name
        With .Range("A1", .cells(.Rows.Count, "S").End(xlUp)) '<--| reference its columns A:S range from row 1 (header) down to the one corresponding to last column S not empty row
            FormatDefault .cells '<--| set all range cells to their "default" format
            .AutoFilter Field:=19, Criteria1:="New row" '<--| filter column S cells with "New row"
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then Set newRowRng = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--| if any filtered cells other than headers then set 'newRowRng' to them
            .Parent.AutoFilterMode = False '<--| remove autofilter
        End With

        If newRowRng Is Nothing Then Exit Sub '<--| if no "newRow" in column S then exit sub

        For Each myRow In Intersect(newRowRng, .Columns(1)) '<--| loop through column A "filtered" cells
            If myRow.Value = myRow.Offset(-1).Value Then '<--| if current cell value equals the one above
                With Intersect(newRowRng, myRow.EntireRow) '<--| reference current cell entire data row
                    Set f = .Find(what:="y", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--| search it for "y"
                    If Not f Is Nothing Then '<--| if found
                        firstAddress = f.Address '<--| store first found cell address
                        Do '<--| start a loop
                            If Len(f.Offset(-1)) = 0 Then FormatCell f '<--| if empty cell above current found cell thne set this latter format
                            Set f = .FindNext(f) '<--| search for the next "y"
                        Loop While Not f.Address = firstAddress '<--| exit whne 'Find()' wraps back to first found cell
                    End If
                End With
            End If
        Next
    End With

End Sub

Sub FormatDefault(rng As Range)
    With rng
        With .Font
            .Color = 0
            .TintAndShade = 0
        End With
        With .Interior
            .Color = 16777215
            .PatternColorIndex = -4142
            .TintAndShade = 0
        End With
    End With
End Sub

Sub FormatCell(rng As Range)
    With rng
        With .Font
            .Color = -16383844
            .TintAndShade = 0
        End With
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
    End With
End Sub

绑定多个条件 IsEmpty Cell.Value 和 Offset

Tying multiple conditions IsEmpty Cell.Value and Offset

vba

offset