Conversion de nombres Romain en Décimal

Commenter

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

S'inscrire maintenant

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.

Du même auteur (cs_casy)