Conversion de nombres Romain en Décimal

Soyez le premier à donner votre avis sur cette source.

Snippet vu 15 212 fois - Téléchargée 9 fois

Contenu du snippet

Public Function CVTRomDec(valeur As String) As Long
'Pour Excel en cellule : Public Function CVTRomDec(cellule  As  Range) As Long
'Dim valeur  As  String
'valeur  =  CStr(cellule.value)
Dim sum As Long
Dim incr As Long
Dim decr As Long
Dim i As Integer
If Len(valeur) = 0 Then
  CVTRomDec = 0
  Exit Function
End If
sum = 0
For i = Len(valeur) To 1 Step -1
  incr = 0
  decr = 0
  Select Case Mid(valeur, i, 1)
    Case "I"
      incr = 1
    Case "V"
      incr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
    Case "X"
      incr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
    Case "L"
      incr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
    Case "C"
      incr = 100
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
    Case "D"
      incr = 500
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "C" Then decr = 100
    Case "M"
      incr = 1000
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "C" Then decr = 100
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "D" Then decr = 500
    Case Else
      CVTRomDec = 0
      Exit Function
  End Select
  sum = sum + incr
  If decr <> 0 Then
    sum = sum - decr
    i = i - 1
  End If
Next
CVTRomDec = sum
End Function


Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.