Option Explicit
Sub Test()
ActiveSheet.Cells.FormatConditions.Delete
DécimalesOmises Rng:=ActiveSheet.[B2:B11], NbDéc:=2, Unité:=" km²"
End Sub
Sub DécimalesOmises(ByVal Rng As Range, ByVal NbDéc As Integer, Optional ByVal Unité As String)
Dim Zéros As String
With Application: .EnableEvents = False: .Calculation = xlCalculationManual
.ScreenUpdating = False: End With
If Unité <> "" Then Unité = """" & Unité & """"
Rng.NumberFormat = "0.0" & String(NbDéc - 1, "?") & Unité
Zéros = String(NbDéc, "0")
MeFCR1C1(Rng, "=ROUND(RC*1" & Zéros & ",0)=ROUND(RC,0)*1" & Zéros).NumberFormat _
= "0_." & Replace(Zéros, "0", "_0") & Unité
With Application: .EnableEvents = True: .Calculation = xlCalculationAutomatic: End With
End Sub
Private Function MeFCR1C1(ByVal Rng As Range, ByVal Formule As String) As FormatCondition
With ActiveSheet.Names.Add(Name:="NomTemporairePourMeFC", RefersToR1C1:=Formule)
Application.GoTo Rng(1, 1)
Set MeFCR1C1 = Rng.FormatConditions.Add(Type:=xlExpression, Formula1:=.RefersToLocal)
.Delete: End With
MeFCR1C1.StopIfTrue = False
End Function