Question

目标：

如果没有公式，则更改背景颜色（当用户覆盖默认公式时，需要突出显示）

Private Sub Worksheet_Change(ByVal Target As Range)

Set currentsheet = ActiveWorkbook.Sheets("Audit Findings")    
'#############
'CHECK IF ANY MISSING FORMULAS WHERE NOT ALLOWED
Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = currentsheetRange("J7:J11")

For Each cell In rng

    If cell.HasFormula Then
      Range(cell.Address).Interior.ColorIndex = 37
      ' MsgBox "Cell " & cell.Address & " contains a formula."
    Else
        Range(cell.Address).Interior.Color = RGB(255, 0, 0)
       'MsgBox "The cell has no formula."
    End If

Next cell    

'#############

'CHECK IF ANY BLANKS WHERE NOT ALLOWED
On Error GoTo Whoa

Application.EnableEvents = False
'Set range to check
If Not Intersect(Target, Range("E7:J11")) Is Nothing Then
     'check length and reverse if blank as has to be a value
     '#################
If Len(Trim(Target.Value)) = 0 Then Application.Undo
End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue


End Sub

参考文献：

Looping

Cell content

Background colour

Answer 1

您的代码工作正常（除非您在两种情况下都提供的代码将内部颜色更改为红色）。

我会将此代码移至Worksheet_Change事件，然后只扫描被修改的单元格是否在扫描范围内（不再需要For Each cell In rng循环）

Private Sub Worksheet_Change(ByVal Target As Range)

Dim WatchRange                  As Range
Dim IntersectRange              As Range

' modify range to suit your needs
Set WatchRange = Range("J7:J11")
Set IntersectRange = Intersect(Target, WatchRange)

If Not IntersectRange Is Nothing Then

    If Target.HasFormula Then
      Target.Interior.Color = RGB(0, 255, 0) ' has formula >> color green
      ' MsgBox "Cell " & cell.Address & " contains a formula."
    Else
        Target.Interior.Color = RGB(255, 0, 0) ' has no formula >> color red
       'MsgBox "The cell has no formula."
    End If

End If

End Sub

当用户更改公式时更改背景

1 个答案: