Compter en nombres romains

Je cherche une fonction qui m'écrive les nombres comme les romains mais qui aille au delà des 3999 prévus par excel.

la fonction ROMAIN() transforme effectivement les nombres en chiffres romains jusqu'à 3999. Il paraîtrait que les romains n'avaient pas été plus loin dans leur méthode, ce qui fait qu'au delà de 3999, il n'y a pas d'autre nombre que les M pour les milliers.
10 152 s'écrirait ainsi MMMMMMMMMMCLII. Voici donc une fonction que j'ai nommée NBRE_ROMAIN() qui, elle, va au maximum possible des milliers.
Elle ne parle pas de millions, nombre non prévu par les romains. De même, elle compte en nombres romains inventés au moyen âge sur le principe de 4=IV au lieu de 4 =IIII comme faisaient les romains (ils étaient fadas ceux là:-))
De même 900 = CM et non DCCCC =NBRE_ROMAIN(E6;2) donnera la valeur DCCCC
=NBRE_ROMAIN(E6;1) donnera la valeur CM J'ai utilisé la méthode que voici: Pour les milliers, j'ai divisé le nombre par 1000 et pris l'entier Pour les centaines j'ai pris le nombre moins les milliers et divisé l'entier par 100 Pour les dizaines Le nombre - les milliers et les centaines divisé par 10 puis le reste.

Function NBRE_ROMAIN(NBR As Integer, Vers As Integer)
'pour les milliers
MR = Int(NBR / 1000)
If MR > 0 Then
For I = 1 To MR
TMR = TMR & "M"
Next
End If
'pour les centaines
CR = Int((NBR - (MR * 1000)) / 100)
If Vers = 1 And CR >= 9 Then
TCR = "CM"
End If
If Vers 1 And CR >= 9 Then
TCR = "DCCCC"
End If
If CR >= 5 And CR For K = 6 To CR
C = "C" & C
Next
TCR = "D" & C
End If
If CR >= 4 And CR TCR = "CD"
End If
If CR > 0 And CR For J = 1 To CR
TCR = TCR & "C"
Next
End If
'pour Les dizaines
DR = Int((NBR - ((MR * 1000) + (CR * 100))) / 10)
If DR >= 9 Then
TDR = "XC"
End If
If DR >= 5 And DR For L = 6 To DR
d = d & "X"
Next
TDR = "L" & d
End If
If DR >= 4 And DR TDR = "XL"
End If
If DR For L = 1 To DR
TDR = TDR & "X"
Next
End If

'pour les unités
UR = NBR - ((MR * 1000) + (CR * 100) + (DR * 10))
If Vers = 1 And UR >= 9 Then
TUR = "IX"
End If
If Vers 1 And UR >= 9 Then
TUR = "VIIII"
End If
If UR >= 5 And UR For L = 6 To UR
U = U & "I"
Next
TUR = "V" & U
End If
If UR >= 4 And UR TUR = "IV"
End If
If UR For U = 1 To UR
TUR = TUR & "I"
Next
End If
NBRE_ROMAIN = TMR & TCR & TDR & TUR
End Function
Auteur(s) : 

Ce mois-ci sur Excelabo

- Pas de nouvelle page.
- 7 pages modifiées.