Results 1 to 3 of 3
  1. #1
    Super Moderator WebGenii's Avatar
    Join Date
    Jan 2001
    Location
    Redcliff, Alberta, Canada
    Posts
    4,066
    Thanks
    2
    Thanked 5 Times in 5 Posts

    ROMAN function (Excel All)

    Ok this time I'm looking at the ROMAN function, the function that converts an Arabic number into Roman numerals.

    Honestly, the usefulness of this is pretty murky to me - unless you are trying to make your spreadsheets even harder to read.

    So what I would find useful is a function to convert Roman numerals back into Arabic.

    Any Ideas?
    [b]Catharine Richardson (WebGenii)
    WebGenii Home Page
    Moderator: Spreadsheets, Other MS Apps, Presentation Apps, Visual Basic for Apps, Windows Mobile

  2. #2
    3 Star Lounger
    Join Date
    Aug 2004
    Posts
    361
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: ROMAN function (Excel All)

    <P ID="edit" class=small>(Edited by WebGenii on 17-May-06 12:31. )</P> Google groups

    has a vba solution for doing what you want.

    Sorry, I don't know how to make this a live link in the Lounge.

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: ROMAN function (Excel All)

    Here's another version:

    Function Roman2Num(ByVal s As String)
    ' Converts a Roman number (as string) into a decimal number
    ' Valid input: the equivalent of 1-3999
    ' Doesn't check for correct construction of Roman number
    Dim RetVal As Integer
    Dim Ctr As Integer
    Dim PrevVal As Integer
    Dim CurVal As Integer
    On Error GoTo Err_Function
    For Ctr = Len(s) To 1 Step -1
    Select Case Mid(s, Ctr, 1)
    Case "I"
    CurVal = 1
    Case "V"
    CurVal = 5
    Case "X"
    CurVal = 10
    Case "L"
    CurVal = 50
    Case "C"
    CurVal = 100
    Case "D"
    CurVal = 500
    Case "M"
    CurVal = 1000
    Case Else
    Err.Raise vbObjectError + 1
    End Select
    If CurVal < PrevVal Then
    RetVal = RetVal - CurVal
    Else
    RetVal = RetVal + CurVal
    End If
    PrevVal = CurVal
    Next Ctr
    Roman2Num = RetVal
    Exit Function
    Err_Function:
    Roman2Num = Null
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •