0
Thanks

A few words of thanks would be greatly appreciated.

# VB/VBA - Convert Roman number to Arabic

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
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```

0
Thanks

A few words of thanks would be greatly appreciated.

CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jeff Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.
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).

Recommended

DON'T MISS

TRENDING GAMES & APPS
• Professional

• Internet

• Internet

• Professional

• Internet

• Internet

• Video games

• Internet

• Video games

• Professional

• Video games