Excel條件格式不起作用？

Question

我有一個工作簿，像這樣：

Column A   U   
Supplier A   10 
Supplier B   1 
Supplier C   5 
Supplier D   9 

我想強調整個行紅，只是在B列前10位的數字

這裏是我的條件格式規則：

對於某些原因，行只改變字體顏色，並且行未突出顯示。我認爲這與我關閉計算有關？

我的VBA代碼包括：

Option Explicit 
Sub code() 
MsgBox "This will take upto 3 minutes." 
Application.ScreenUpdating = False 
Dim WB As Workbook 
Dim i As Long 
Dim j As Long 
Dim Lastrow As Long 

On Error Resume Next 
Set WB = Workbooks("L.O. Lines Delivery Tracker.xlsm") 
On Error GoTo 0 
If WB Is Nothing Then 'open workbook if not open 
    Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) L.O. Delivery Tracking\L.O. Lines Delivery Tracker.xlsm") 
End If 

' ======= Edit #2 , also for DEBUG ====== 
With WB.Worksheets(1) 
    Lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row 

    j = 2 

     For i = 7 To Lastrow 


     ' === For DEBUG ONLY === 
     Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F9").value) 
     Debug.Print Month(.Range("G" & i).value) 
     Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F10").value) 
     Debug.Print Year(.Range("G" & i).value) 
     Debug.Print ThisWorkbook.Worksheets(1).Range("B6").value 
     Debug.Print .Range("M" & i).value 


     If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(.Range("G" & i).value) Then ' check if Month equals the value in "A1" 
      If CInt(ThisWorkbook.Worksheets(1).Range("F10").value) = Year(.Range("G" & i).value) Then ' check if Year equals the value in "A2" 
      If ThisWorkbook.Worksheets(1).Range("B6").value = .Range("M" & i).value Then 
       ThisWorkbook.Worksheets(2).Range("A" & j).value = .Range("G" & i).value 
       ThisWorkbook.Worksheets(2).Range("B" & j).Formula = "=MONTH(B" & j & ")" 
       ThisWorkbook.Worksheets(2).Range("C" & j).value = .Range("L" & i).value 
       ThisWorkbook.Worksheets(2).Range("D" & j).value = .Range("D" & i).value 
       ThisWorkbook.Worksheets(2).Range("E" & j).value = .Range("E" & i).value 
       ThisWorkbook.Worksheets(2).Range("F" & j).value = .Range("F" & i).value 
       ThisWorkbook.Worksheets(2).Range("g" & j).value = .Range("p" & i).value 
       ThisWorkbook.Worksheets(2).Range("H" & j).value = .Range("H" & i).value 
       ThisWorkbook.Worksheets(2).Range("I" & j).value = .Range("I" & i).value 
       ThisWorkbook.Worksheets(2).Range("J" & j).value = .Range("J" & i).value 
       ThisWorkbook.Worksheets(2).Range("k" & j).value = .Range("Q" & i).value 
       ThisWorkbook.Worksheets(2).Range("L" & j).value = .Range("m" & i).value 
       j = j + 1 
      End If 
      End If 
     End If 
    Next i 

End With 



Worksheets(1).UsedRange.Columns("B:AA").Calculate 


On Error GoTo Message 
With ThisWorkbook.Worksheets(1) '<--| change "mysheet" to your actual sheet name 
    Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).WrapText = True 
    Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).EntireRow.AutoFit 
End With 




'End 


Application.ScreenUpdating = True 


Exit Sub 
Message: 
On Error Resume Next 
Exit Sub 


End Sub 

而且

Private Sub Worksheet_Change(ByVal Target As Range) 
Application.Calculation = xlManual 
Application.CalculateBeforeSave = False 
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Application.Calculation = xlManual 
Application.CalculateBeforeSave = False 
End Sub 

而且

Private Sub Workbook_Open() 
Application.Calculation = xlManual 
Application.CalculateBeforeSave = False 
End Sub 


Private Sub Workbook_BeforeClose(Cancel As Boolean) 
Application.Calculation = xlManual 
Application.CalculateBeforeSave = False 
End Sub 

請能有人告訴我在哪裏，我錯了？

Answer 1

請嘗試：

Sub CF() 
    Cells.Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
     "=AND($B1>=LARGE($B:$B,10),ROW()<>1)" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1) 
    .Interior.Color = 255 
    .StopIfTrue = False 
    End With 
End Sub