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

Excel条件格式不起作用？

1 个答案: