ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   transform formula (https://www.excelbanter.com/excel-worksheet-functions/252949-transform-formula.html)

driller

transform formula
 
Hello again,

I am preparing a classic presentation of numbers.

I just need it for a catchy test.

Is there a macro or any formula to convert whole numbers into Romen numerals ?

thanks in advance

T. Valko

transform formula
 
Look in Excel help for the ROMAN function.

The result can be displayed in various forms so see help to determine which
form you want.

--
Biff
Microsoft Excel MVP


"driller" wrote in message
...
Hello again,

I am preparing a classic presentation of numbers.

I just need it for a catchy test.

Is there a macro or any formula to convert whole numbers into Romen
numerals ?

thanks in advance




Rick Rothstein

transform formula
 
I am preparing a classic presentation of numbers.

I just need it for a catchy test.

Is there a macro or any formula to convert whole numbers into Romen
numerals ?


Here are two functions I've posted in the distant past (written for the
compiled version of VB, but which work fine in VBA), one for converting to
Roman Numbers and the other to convert from Roman Numbers...

Function ToRoman(ByVal Number As Long) As String
Dim X As Integer
Dim DigitIndex As Integer
Dim MaxNumeralCount As Integer
Dim Digits() As Byte
Dim Numerals() As Byte
Numerals = StrConv("IVXLCDM", vbFromUnicode)
MaxNumeralCount = Number \ 10 ^ (UBound(Numerals) \ 2)
Number = Number Mod 10 ^ (UBound(Numerals) \ 2)
ToRoman = String$(MaxNumeralCount, _
Numerals(UBound(Numerals)))
Digits = StrConv(CStr(Number), vbFromUnicode)
For X = 0 To UBound(Digits)
DigitIndex = 2 * (UBound(Digits) - X)
If Digits(X) = vbKey9 Then
ToRoman = ToRoman & Chr$(Numerals(DigitIndex)) & _
Chr$(Numerals(DigitIndex + 2))
ElseIf Digits(X) = vbKey5 Then
ToRoman = ToRoman & Chr$(Numerals(DigitIndex + 1)) & _
String$(Digits(X) - vbKey0 - 5, _
Chr$(Numerals(DigitIndex)))
ElseIf Digits(X) = vbKey4 Then
ToRoman = ToRoman & Chr$(Numerals(DigitIndex)) & _
Chr$(Numerals(DigitIndex + 1))
Else
ToRoman = ToRoman & String$(Digits(X) - vbKey0, _
Chr$(Numerals(DigitIndex)))
End If
Next
End Function

Function FromRoman(ByVal RomanNumber As String) As Long
Dim DigitCount As Integer
Dim NumeralCount As Integer
Dim Answer() As Long
Dim Digits() As Byte
Dim RomanNumerals() As Byte
RomanNumerals = StrConv("IVXLCDM", vbFromUnicode)
Digits = StrConv(UCase$(RomanNumber), vbFromUnicode)
ReDim Answer(UBound(Digits))
For DigitCount = UBound(Digits) To 0 Step -1
For NumeralCount = 0 To UBound(RomanNumerals)
If Digits(DigitCount) = RomanNumerals(NumeralCount) Then
If NumeralCount Mod 2 Then
Answer(DigitCount) = 5 * 10 ^ ((NumeralCount - 1) / 2)
Else
Answer(DigitCount) = 10 ^ (NumeralCount / 2)
End If
Exit For
End If
Next
Next
For DigitCount = UBound(Answer) To 0 Step -1
If DigitCount < UBound(Answer) Then
If Answer(DigitCount) < Answer(DigitCount + 1) Then
Answer(DigitCount) = -Answer(DigitCount)
End If
End If
FromRoman = FromRoman + Answer(DigitCount)
Next
End Function

--
Rick (MVP - Excel)


driller

transform formula
 
thanks a lot.

just found out that the 4 digit "2010" is equal to a 3 letter numeral "MMX".


All times are GMT +1. The time now is 08:36 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com