How do I convert Roman numerals to Arabic (reverse of ROMAN)?
 

I can use the ROMAN function, but does anyone know a way of reversing the
function to get Arabic numerals from Roman?

How do I convert Roman numerals to Arabic (reverse of ROMAN)?
 

Function arabic(RomanString As String) As Long
Dim i As Long
Dim TryString As String
arabic = 0
For i = 1 To 3999
TryString = Application.WorksheetFunction.Roman(i)
If TryString = RomanString Then
arabic = i
Exit For
End If
Next
End Function
--
Gary''s Student - gsnu200718

How do I convert Roman numerals to Arabic (reverse of ROMAN)?
 

Thanks - thought there might have been a function included, but this looks
neat enough.

Ian

"Gary''s Student" wrote:

Function arabic(RomanString As String) As Long
Dim i As Long
Dim TryString As String
arabic = 0
For i = 1 To 3999
TryString = Application.WorksheetFunction.Roman(i)
If TryString = RomanString Then
arabic = i
Exit For
End If
Next
End Function
--
Gary''s Student - gsnu200718

How do I convert Roman numerals to Arabic (reverse of ROMAN)?
 

Try this UDF:

Option Base 1
Function arab(romai As String, Optional forma)
rbetuk = Array("I", "V", "X", "L", "C", "D", "M")
ertekek = Array(1, 5, 10, 50, 100, 500, 1000)
sulyok = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
elojelek = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
hossz = Len(romai)
For i = 1 To hossz
sulyok(i) = ertekek(WorksheetFunction.Match(Mid(romai, i, 1),
rbetuk, 0))
If i < hossz Then
If sulyok(i) < ertekek(WorksheetFunction.Match(Mid(romai, i + 1,
1), rbetuk, 0)) Then
elojelek(i) = -1 'előjel
End If
End If
Next i
arab = WorksheetFunction.SumProduct(sulyok, elojelek)
If IsMissing(forma) Then
If Not (romai = WorksheetFunction.Roman(arab, 0) Or _
romai = WorksheetFunction.Roman(arab, 1) Or _
romai = WorksheetFunction.Roman(arab, 2) Or _
romai = WorksheetFunction.Roman(arab, 3) Or _
romai = WorksheetFunction.Roman(arab, 4)) _
Then arab = WorksheetFunction.Match("A", rbetuk, 0)
Else
If Not (romai = WorksheetFunction.Roman(arab, forma)) _
Then arab = WorksheetFunction.Match("A", rbetuk, 0)
End If
End Function


Usage:
If you omit "forma" argument, then the function converts Roman numbers of
any type (See Help on function ROMAN), if you supply "forma" argument, the
function converts only Roman numbers of the given type.

Regards,
Stefi


€žIanW€� ezt Ã*rta:

I can use the ROMAN function, but does anyone know a way of reversing the
function to get Arabic numerals from Roman?

How do I convert Roman numerals to Arabic (reverse of ROMAN)?
 

On Fri, 4 May 2007 03:26:02 -0700, IanW wrote:

I can use the ROMAN function, but does anyone know a way of reversing the
function to get Arabic numerals from Roman?


You can use a UDF:

==========================================
Function Arabic(rg As Range) As Long
Const m As Long = 1000
Const d As Long = 500
Const c As Long = 100
Const l As Long = 50
Const X As Long = 10
Const v As Long = 5
Const i As Long = 1

Dim temp()
Dim j As Long

ReDim temp(Len(rg.Text) - 1)

For j = 1 To Len(rg.Text)
temp(j - 1) = Mid(rg.Text, j, 1)
Next j

For j = 0 To UBound(temp)
Select Case temp(j)
Case Is = "M"
temp(j) = m
Case Is = "D"
temp(j) = d
Case Is = "C"
temp(j) = c
Case Is = "L"
temp(j) = l
Case Is = "X"
temp(j) = X
Case Is = "V"
temp(j) = v
Case Is = "I"
temp(j) = i
Case Else
MsgBox ("Illegal Character")
Exit Function
End Select
Next j

For j = 0 To UBound(temp) - 1
If temp(j) < temp(j + 1) Then
If temp(j) * 10 = temp(j + 1) And _
temp(j) = i Or _
temp(j) = X Or _
temp(j) = c Then
temp(j) = -temp(j)
Else
MsgBox ("Illegal Construction")
End If
End If
Next j

Arabic = Application.WorksheetFunction.Sum(temp)

End Function
=========================================
--ron

How do I convert Roman numerals to Arabic (reverse of ROMAN)?
 

On Fri, 4 May 2007 03:26:02 -0700, IanW wrote:

I can use the ROMAN function, but does anyone know a way of reversing the
function to get Arabic numerals from Roman?


You can use a UDF:

Please note the change I just made in the first line of the UDF. Specifying
"rg as range" messes up the calculation order. Specifying without the Type
seems to work better.

==========================================
Function Arabic(rg) As Long
Const m As Long = 1000
Const d As Long = 500
Const c As Long = 100
Const l As Long = 50
Const X As Long = 10
Const v As Long = 5
Const i As Long = 1

Dim temp()
Dim j As Long

ReDim temp(Len(rg.Text) - 1)

For j = 1 To Len(rg.Text)
temp(j - 1) = Mid(rg.Text, j, 1)
Next j

For j = 0 To UBound(temp)
Select Case temp(j)
Case Is = "M"
temp(j) = m
Case Is = "D"
temp(j) = d
Case Is = "C"
temp(j) = c
Case Is = "L"
temp(j) = l
Case Is = "X"
temp(j) = X
Case Is = "V"
temp(j) = v
Case Is = "I"
temp(j) = i
Case Else
MsgBox ("Illegal Character")
Exit Function
End Select
Next j

For j = 0 To UBound(temp) - 1
If temp(j) < temp(j + 1) Then
If temp(j) * 10 = temp(j + 1) And _
temp(j) = i Or _
temp(j) = X Or _
temp(j) = c Then
temp(j) = -temp(j)
Else
MsgBox ("Illegal Construction")
End If
End If
Next j

Arabic = Application.WorksheetFunction.Sum(temp)

End Function
=========================================
--ron