[IanW[_2_]]

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

[Gary''s Student]

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

[IanW[_2_]]

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

[Stefi]

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?

[Ron Rosenfeld]

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

[Ron Rosenfeld]

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