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

目标:

如果没有公式,则更改背景颜色(当用户覆盖默认公式时,需要将其突出显示)

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 

参考文献:

循环

细胞内容

背景色

你的代码工作正常(除了你提供的代码,你把内部颜色改为红色)。

我将这个代码移动到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