搭配多個條件IsEmpty Cell.Value and Offset

Question

我想突出顯示符合某些標準集的單元格。列D到Q之間的所有單元格都是應該實現的範圍。

單元格值必須等於「y」。
S列中的相鄰單元格必須等於「新行」。 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

我提出一個 「非條件格式」 的方法如下：

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