Tester les cellules d'un range

Bonjour à tous.

Je cherche a tester chaque cellule d'un très gros range sur plusieurs critères.

La cellule contient une formule

La valeur de la cellule n'est pas un nombre

La cellule n'est pas vide

La cellule ne contient pas d'erreur

La cellule n'a pas de couleur de fonD

Si une cellule remplie tous ces critères, on la grise.

Voici le code que j'ai fait

Private Sub Worksheet_activate()
Dim table As Range
Dim cell As Object
Range("A1", "DZ638").Select

For Each cell In Selection
If Not cell.Value Is Null And Not IsError(cell.Formula) And cell.Font.Color = RGB(255, 255, 255) And Not cell.Value.IsNumber And cell.HasFormula Then
cell.Font.Color = RGB(180, 180, 180)
End If
Next
End Sub

Mais ça coince au niveau du IF, c'est surement la syntaxe qui n'est pas assez précise.

Quelqu’un sait comment remettre ça en place?

Bonjour,

A tester dans ton classeur :

Option Explicit
Private Sub Worksheet_activate()
Dim rng As Range, rng2 As Range, cell As Range
    Application.ScreenUpdating = False
    Set rng = [A1:DZ638]
    Set rng2 = rng.SpecialCells(xlCellTypeFormulas, 2)
    For Each cell In rng2
        If Not cell = "" And Not cell.Interior.Color Then cell.Interior.Color = RGB(192, 192, 192)
    Next cell
    Set rng2 = Nothing: Set rng = Nothing
End Sub

Teste chaque partie séparément :

Sub test()
Dim table As Range
Dim cell As Object
Range("A1", "D1").Select

For Each cell In Selection
If cell.HasFormula Then
' Not cell.Value Is Null --> problème
' Not IsError(cell.Formula) = ok
' cell.Font.Color = RGB(255, 255, 255) = blanc ok
' Not cell.Value.IsNumber --> problème
' cell.HasFormula = ok

' cell.Font.Color = RGB(180, 180, 180)
MsgBox "ok"
End If
Next
End Sub

Ca coince chez moi sur Not cell.Value.IsNumber et Not cell.Value Is Null

J'ai bien noté que tu testais une couleur de police blanche !

Re,

Je dois modifier pour la couleur.

Je reviens...

Re,

A tester...

Option Explicit
Private Sub Worksheet_activate()
Dim rng As Range, rng2 As Range, cell As Range
    Application.ScreenUpdating = False
    Set rng = [A1:DZ638]
    Set rng2 = rng.SpecialCells(xlCellTypeFormulas, 2)
    For Each cell In rng2
        If Not cell = "" And cell.Interior.Pattern = xlNone Then cell.Interior.Color = RGB(192, 192, 192)
    Next cell
    Set rng2 = Nothing: Set rng = Nothing
End Sub

Et si on veut faire plus court :

Option Explicit
Public Sub test()
Dim cell As Range
    For Each cell In Range("A1:DZ638").SpecialCells(xlCellTypeFormulas, 2)
        If Not cell = "" And cell.Interior.Pattern = xlNone Then cell.Interior.Color = RGB(192, 192, 192)
    Next cell
End Sub

Ça fonctionne jean Eric, merci beaucoup!

Petite question, a quoi sert ce "option explicit"?

Merci à Steelson aussi bien sûr