檢查工作表中是否有任何公式

Question

我有一段代碼貫穿我的工作表並突出顯示其中有公式的所有單元。但是，如果在工作表中沒有包含公式的單元格，代碼的這部分工作正常，那麼代碼將崩潰。我想要做的是，如果在電子表格中沒有公式，那麼放入一個if語句將結束代碼。我試圖循環遍歷單元格，並檢查每個單元格是否有公式，但同樣崩潰。所以我想要做的是修復if語句。

任何幫助將不勝感激。

高亮代碼

'Apply yellow highlight to all formula cells. 

Dim ws As Worksheet 
Dim rng As Range 

Set ws = ActiveSheet 
For Each rng In ws.Cells.SpecialCells(xlCellTypeFormulas) 
rng.Interior.ColorIndex = 36 
Next rng 

代碼if語句

'Apply yellow highlight to all formula cells. 

Dim ws As Worksheet 
Dim rng As Range 

Set ws = ActiveSheet 

c = 0 
For Each cell in ws.Cells 
If cell.HasFormula = True Then 
c= c + 1 
End If 
Next cell 

If c > 0 Then 
For Each rng In ws.Cells.SpecialCells(xlCellTypeFormulas) 
rng.Interior.ColorIndex = 36 
Next rng 
Else MsgBox ("No formulas in this worksheet") 
End If 

Answer 1

您可以使用錯誤代碼處理。

On Error Resume Next將繼續執行下一行而不會中斷腳本，即使發生錯誤。
On Error Goto 0禁用當前過程中啓用的錯誤處理程序並將其重置爲Nothing。

Sub test() 

    Dim ws As Worksheet 
    Dim rng As Range, cell As Range 

    Set ws = ActiveSheet 
    On Error Resume Next 
    Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas) 
    On Error GoTo 0 

    If rng Is Nothing Then 
     MsgBox "No cells found" 
     Exit Sub 
    End If 

    For Each cell In rng 
     cell.Interior.ColorIndex = 36 
    Next 

End Sub 

Answer 2

另一種方式

Sub t() 
    Dim ws As Worksheet 
    Dim rng As Range 

    Set ws = ActiveSheet 

    If ws.Cells.SpecialCells(xlCellTypeFormulas).Count > 0 Then 
     For Each rng In ws.Cells.SpecialCells(xlCellTypeFormulas) 
      rng.Interior.ColorIndex = 36 
     Next rng 
    Else: MsgBox ("No formulas in this worksheet") 
    End If 
End Sub 

Answer 3

Sub subCheckForFormla() 
    Dim ws As Worksheet 
    Dim cnt As Integer 
    Dim cel 

    On Error Resume Next 
    For Each ws In ThisWorkbook.Worksheets 
     If ws.Cells.SpecialCells(xlCellTypeFormulas).Count > 0 Then 
      If Not Err = 1004 Then 
       For Each cel In ws.Cells.SpecialCells(xlCellTypeFormulas).Cells 
        cel.Interior.ColorIndex = 36 
       Next cel 
      End If 
     End If 
    Next ws 
End Sub