当用户更改删除公式时更改背景
目标:
如果没有公式,则更改背景颜色(当用户覆盖默认公式时,需要将其突出显示)
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