VB/VBA - Convert Roman number to Arabic

May 2017




These functions allow the conversion of numbers expressed in Roman "letters" (MCMLXIX ) in Arabic number format (1969). These procedures are available as a custom function for Excel and in VBA for a Userform. VBA code is compatible with VB6.

Function for Excel


Paste the code below in a general module, e.g Module1.
Dim Rm As String 

Public Function RomainArabe(C As Range) As Integer 
Dim TB 
Dim Arab As Integer 
Dim i As Byte, A As Integer, Utb As Integer 
    If C = "" Then RomainArabe = 0: Exit Function 
ReDim TB(0) 
    Application.Volatile 
    i = 1: Utb = 1: Arab = 0 
    Rm = Replace(C, " ", "") 'supprime les espaces éventuels 
    Rm = UCase(Rm) ' met en majuscule si nécessaire 
    While i <= Len(Rm) 
        'traite les lettres une a une 
        ReDim Preserve TB(Utb) 
        A = NBlettre(i) 
        TB(Utb) = A * ValeurLettre(Mid(Rm, i, 1)) 
        Debug.Print TB(Utb) 
        i = i + A 
        Utb = Utb + 1 
    Wend 
    ReDim Preserve TB(Utb): i = 1 
    While i < UBound(TB) 
        If TB(i) < TB(i + 1) Then 
             Arab = Arab + TB(i + 1) - TB(i) 
            i = i + 2 
        Else 
            Arab = Arab + TB(i) 
            i = i + 1 
        End If 
        Debug.Print Arab 
    Wend 
    RomainArabe = Arab 
End Function 
Function NBlettre(Deb As Byte) As Byte 
Dim i As Integer, L As String 
    NBlettre = 1 
    L = Mid(Rm, Deb, 1) 
    For i = Deb + 1 To Len(Rm) 
        If Mid(Rm, i, 1) = L Then 
            NBlettre = NBlettre + 1 
        Else 
            Exit Function 
        End If 
    Next 
End Function 
Function ValeurLettre(L As String) As Integer 
Dim Romain, Arabe, i As Byte 
    Romain = Array("I", "V", "X", "L", "C", "D", "M") 
    Arabe = Array(1, 5, 10, 50, 100, 500, 1000) 
    For i = 0 To 6 
        If L = Romain(i) Then 
            ValeurLettre = Arabe(i) 
            Exit Function 
        End If 
    Next i 
End Function 


Example of a formula to be placed in an Excel spreadsheet
'=RomainArabic(A3)  

VBA/ VB6 Codes




Paste the code below in a general module, e.g Module1 for VBA or in a Module.bas for VB6
Option Explicit 
Dim Rm As String 

Public Function TraduitRomain(Rm) As Integer 
Dim TB 
Dim Arab As Integer 
Dim i As Byte, A As Integer, Utb As Integer 

ReDim TB(0) 
    i = 1: Utb = 1 
    Rm = Replace(Rm, " ", "") 'supprime les espaces éventuels 
    Rm = UCase(Rm) ' met en majuscule si nécessaire 
    While i <= Len(Rm) 
        'traite les lettres une a une 
        ReDim Preserve TB(Utb) 
        A = NBlettre(i) 
        TB(Utb) = A * ValeurLettre(Mid(Rm, i, 1)) 
        Debug.Print TB(Utb) 
        i = i + A 
        Utb = Utb + 1 
    Wend 
    ReDim Preserve TB(Utb): i = 1 
    While i < UBound(TB) 
        If TB(i) < TB(i + 1) Then 
             Arab = Arab + TB(i + 1) - TB(i) 
            i = i + 2 
        Else 
            Arab = Arab + TB(i) 
            i = i + 1 
        End If 
        Debug.Print Arab 
    Wend 
    TraduitRomain = Arab 
End Function 
Private Function NBlettre(Deb As Byte) As Byte 
Dim i As Integer, L As String 
    NBlettre = 1 
    L = Mid(Rm, Deb, 1) 
    For i = Deb + 1 To Len(Rm) 
        If Mid(Rm, i, 1) = L Then 
            NBlettre = NBlettre + 1 
        Else 
            Exit Function 
        End If 
    Next 
End Function 

Private Function ValeurLettre(L As String) As Integer 
Dim Romain, Arabe, i As Byte 
    Romain = Array("I", "V", "X", "L", "C", "D", "M") 
    Arabe = Array(1, 5, 10, 50, 100, 500, 1000) 
    For i = 0 To 6 
        If L = Romain(i) Then 
            ValeurLettre = Arabe(i) 
            Exit Function 
        End If 
    Next i 
End Function


Example of function call:

Sub AppelEnArabic() 
Dim R As String 
    R = "MMMCMIC" 
    MsgBox R & " en chiffre arabe donnerait " & TraduitRomain(R) 
End Sub

Related


Published by deri58. Latest update on August 7, 2012 at 07:49 AM by deri58.
This document, titled "VB/VBA - Convert Roman number to Arabic," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).