Appliquer un format différent si entier ou décimal

Bonjour:

Je cherche à appliquer un format de cellule différent, suivant si la valeur dans la cellule est un nombre entier ou décimal, sur toute ma feuille.

J'ai donc essayé le script ci-dessous, sans succès. Quelqu'un peut m'aider? Merci!

Sub milliers()

For Each c In Range("A1:AM2500")

‘Ici, j'ai essayé de couvrir une zone assez large, mais ça ralentit mon PC quelques secondes.

If VarType(c) = 2 Then

c.NumberFormat = "#,##0_ ;-#,##0"

Else

If VarType(c) = 14 Then

c.NumberFormat = "0.00"

Else

End If

End If

Next c

End Sub

Bonjour,

A tester et à adapter en fonction du format désiré pour les cellules avec valeurs décimales.

Cdlt.

Option Explicit
Public Sub Milliers()
Dim Ws As Worksheet
Dim Derligne As Long
Dim Plage As Range, c As Range

     Application.ScreenUpdating = False
     Set Ws = Worksheets("Feuil1")
     With Ws
          Derligne = .Range("A" & Rows.Count).End(xlUp).Row
          Set Plage = .Range("A2:A" & Derligne)
          For Each c In Plage
               If c - Int(c) = 0 Then
                    c.NumberFormat = "#,##0;-#,##0"
               Else
                    c.NumberFormat = "0.00"
               End If
          Next c
     End With

     Set Ws = Nothing: Set Plage = Nothing

End Sub

Bonjour Jean-Eric:

Je te remercie pour ta réponse!

Le code a l’air intéressant, mais la ligne suivante pose problème à l’exécution :

If c - Int(c) = 0 Then

Le message d’erreur est : « incompatibilité de types »

J’ai essayé les alternatives suivantes sans succès :

If c.Value - Int(c.Value) = 0 Then

If (c.Value - Int(c.Value)) = 0 Then

If c.Value - Int(c).Value = 0 Then

Comment résoudre ce problème?

PS:

J’ai testé l’idée de déterminer si un nombre est entier en lui soustrayant sa valeur entière, ça marche :

Range("A16") = Range("A10") - Int(Range("A10"))

Re,

A tester

Option Explicit
Public Sub Milliers()
Dim Ws As Worksheet
Dim Derligne As Long
Dim Plage As Range, c As Range
     Application.ScreenUpdating = False
     Set Ws = Worksheets("Feuil1")
     With Ws
          Derligne = .Range("A" & Rows.Count).End(xlUp).Row
          Set Plage = .Range("A2:A" & Derligne)
          For Each c In Plage
               On Error Resume Next
                    If c.Value - Int(c.Value) = 0 Then
                         c.NumberFormat = "#,##0;-#,##0"
                    Else
                         c.NumberFormat = "0.00"
                    End If
               On Error GoTo 0
          Next c
     End With
     Set Ws = Nothing: Set Plage = Nothing
End Sub

Ça marche!

Un grand merci à Jean-Eric!

J'ai toutefois du faire quelques modifications pour que le script fonctionne sur d'autres colonnes que la colonne A.

Attention, la machine ralentit à l’exécution de "mon" code, et il faut attendre une dizaine de secondes avant qu'Excel soit à nouveau fonctionnel!

Ci-dessous le code légèrement modifié, avec 4 remarques/questions.

Le fichier joint est à jour.

Option Explicit
Public Sub Milliers()
Dim Ws As Worksheet
' Dim Derligne As Long
' Dim DernCol As Integer
' REMARQUE #1: La dernière proposition de Jean-Eric concernait uniquement la colonne A.
Dim Plage As Range, c As Range

     Application.ScreenUpdating = False

     Set Ws = Worksheets("Feuil1")

     With Ws

          ' Derligne = .Range("A" & Rows.Count).End(xlUp).Row
          ' DernCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
          ' Set Plage = .Range("A2:A" & Derligne)
          ' REMARQUE #2: Comment modifier la ligne ci-dessus pour y inclure la variable DernCol?
          ' REMARQUE #3: DernCol n’inclura pas certaines colonnes pleines car leur 1ere ligne est vide, et Derligne n’inclura pas une ligne pleine parce que en "A" elle présente une cellule vide, on ne peut donc pas compter sur cette méthode pour être sûr d'avoir tout traité..

          Set Plage = .Range("A1:AM2500")
          'REMARQUE #4: Ici, on est sûr de couvrir toutes les cellules d'une "petite" feuille de calcul, mais on constatera un ralentissement machine..
          For Each c In Plage
               On Error Resume Next
                    If c.Value - Int(c.Value) = 0 Then
                         c.NumberFormat = "#,##0;-#,##0"
                    Else
                         c.NumberFormat = "0.00"
                    End If
               On Error GoTo 0
          Next c
     End With

     Set Ws = Nothing: Set Plage = Nothing

End Sub

Bonjour,

Voir code modifié.

Cdlt.

Option Explicit
Public Sub Milliers()
Dim Ws As Worksheet
Dim Derligne As Long
Dim Dercolonne As Integer
Dim Plage As Range, c As Range
Dim t As Single

     t = Timer ' initialisation timer
     Application.ScreenUpdating = False
     Set Ws = Worksheets("Feuil1")
     With Ws
          ' dernière ligne non vide Feuil1
          Derligne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
          ' dernière colonne non vide Feuil1
          Dercolonne = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
          Set Plage = .Range(.Cells(1, 1), .Cells(Derligne, Dercolonne))
          For Each c In Plage
               On Error Resume Next
                    If c.Value - Int(c.Value) = 0 Then
                         c.NumberFormat = "#,##0;-#,##0"
                    Else
                         c.NumberFormat = "0.00"
                    End If
               On Error GoTo 0
          Next c
     End With
     Set Ws = Nothing: Set Plage = Nothing
     ' affichage durée procédure
     MsgBox Format(Timer - t, "0.00") & " seconde(s)"
End Sub

Parfait!

Un grand merci à toi Jean-Eric.

Je te souhaite une excellente fin de semaine!

Cordialement.

Re,

Penses à clore le sujet si tu es satisfait.

Cdlt