are you telling the computer to replace the value with one you have already calculated
you can teach the computer how to calculate each value without telling it to memorise every roman numeral... just like you know MCMXCII is 1992
whenever a smaller value is preceded by a larger CM or XC (100=C being less than 1000=M and 10=X less than 100=C) then you know to add the greater to the total sum and subtract the lesser... eg. add a thousand but subtract a hundred.
MCMXCII is really : M - C + M - X + C + I + I
no need to memorise the whole thing...
here a couple of functions that do this...
' at the top of your code you need this user defined type (udt)
Private
Structure udtRomanNumeral
Dim value As Short
Dim symbol As String
End Structure
Public Function getRomanSymbolValue(ByVal strSymbol As String) As Int16
Static udrNumerals(6) As udtRomanNumeral
Static bolInit As Boolean
Dim intCounter As Integer
' this function gets a symbol I, V, X, L, C, D or M and returns their integer values 1, 5, 10, 50, 100, 500 or 1000 respectively
If Not bolInit Then
bolInit =
True
udrNumerals(0).value = 1
udrNumerals(0).symbol =
"I"
udrNumerals(1).value = 5
udrNumerals(1).symbol =
"V"
udrNumerals(2).value = 10
udrNumerals(2).symbol =
"X"
udrNumerals(3).value = 50
udrNumerals(3).symbol =
"L"
udrNumerals(4).value = 100
udrNumerals(4).symbol =
"C"
udrNumerals(5).value = 500
udrNumerals(5).symbol =
"D"
udrNumerals(6).value = 1000
udrNumerals(6).symbol =
"M"
End If
getRomanSymbolValue = -1
For intCounter = 0 To 6
If strSymbol = udrNumerals(intCounter).symbol Then
getRomanSymbolValue = udrNumerals(intCounter).value
Exit Function
End If
Next intCounter
End Function
Public Function evaluateRomanNumeral(ByVal strRoman As String) As Int16
' this function receives a string and evaluates it as a roman numeral and then returns its integer equivalent
' it does this by chopping off the leading characters. Since roman symbols decrease in value from left to right (except when subtracting 1x10^x, e.g. IV, IX, XL, XC, CD or CM)
' then add this value to total, unless it is followed by another symbol of greater value(see previous line)
Dim intTemp, intRank As Integer
Dim numRank As Short
Dim intCounter As Integer
Dim intLeadingCounter As Integer
Dim strSymbol, strThisSymbol As String
Dim strNextSymbol As String
Dim intValue, intThisValue As Integer
Dim intNextValue As Integer
Dim intRank1 As Integer
Dim intRank2 As Integer
Dim strPartialRomant As String
Dim bolLoop As Boolean
Dim strRanking As String
Dim strRememberInputParameter As String
On Error GoTo handler
strRememberInputParameter = strRoman
strRanking =
"IVXLCDM" ' this is used to determine whether one symbol is ranked higher than another by testing the result of instr() for two adjacent symbols
For intCounter = 1 To Len(strRoman)
If InStr(strRanking, Mid(strRoman, intCounter, 1)) = 0 Then
evaluateRomanNumeral = 0 ' if a symbol appears in the input parameter 'strRoman' that does is not a valid Roman Numeral symbol then the output is zero and exit function
Exit Function
End If
Next intCounter
startEvaluateRomanNumeralLoop:
Do While Len(strRoman) > 0
strThisSymbol = Mid(strRoman, 1, 1)
If Len(strRoman) > 1 Then
If Mid(strRoman, 2, 1) <> strThisSymbol Then
' if the first symbol (we are chopping off from the left as we go) is lesser in rank than its following symbol then we need to subtract the first and add the second
intRank1 = InStr(strRanking, strThisSymbol)
intRank2 = InStr(strRanking, Mid(strRoman, 2, 1))
If intRank2 > intRank1 Then
' iv, ix, xl, xc, cd, or cm and such
evaluateRomanNumeral = evaluateRomanNumeral - getromanSymbolValue(strThisSymbol)
evaluateRomanNumeral = evaluateRomanNumeral + getromanSymbolValue(Mid(strRoman, 2, 1))
strRoman = Mid(strRoman, 3)
GoTo startEvaluateRomanNumeralLoop
End If
End If
End If
' since we did not GoTo startEvaluateRomanNumeralLoop we know that this first symbol is the highest in the remaining string and must be added
' count the number of times it appears, multiply that number by its value and add it to the total count
intLeadingCounter = 0 : bolLoop =
True
Do
If Len(strRoman) > 0 Then
If Mid(strRoman, 1, 1) = strThisSymbol Then
intLeadingCounter = intLeadingCounter + 1
strRoman = Mid(strRoman, 2)
Else
bolLoop =
False
End If
Else
bolLoop =
False
End If
Loop While bolLoop
intValue = getRomanSymbolValue(strThisSymbol)
evaluateRomanNumeral = evaluateRomanNumeral + intLeadingCounter * intValue
Loop
' here we test our result with this function's complement, if all is well then we're happy
If Not UCase(getRomanNumeral(evaluateRomanNumeral)) = UCase(strRememberInputParameter) Then
evaluateRomanNumeral = 0
End If
Exit Function
handler:
Stop
Resume
End Function
Public
Function getRomanNumeral(ByVal lngValue As Integer) As String
' this function receives an integer value and returns its Roman numeral equivalent in the form of a string
' it does this by subtracting the value of the highest ranking symbol as it keeps a tally of the count
Static udrNumerals(6) As udtRomanNumeral
Static bolInit As Boolean
Dim intValue As Short
Dim intTemp, intRank As Object
Dim numRank As Short
On Error GoTo handler
If Not bolInit Then
bolInit =
True
udrNumerals(0).value = 1
udrNumerals(0).symbol =
"I"
udrNumerals(1).value = 5
udrNumerals(1).symbol =
"V"
udrNumerals(2).value = 10
udrNumerals(2).symbol =
"X"
udrNumerals(3).value = 50
udrNumerals(3).symbol =
"L"
udrNumerals(4).value = 100
udrNumerals(4).symbol =
"C"
udrNumerals(5).value = 500
udrNumerals(5).symbol =
"D"
udrNumerals(6).value = 1000
udrNumerals(6).symbol =
"M"
End If
getRomanNumeral =
""
If lngValue > 3899 Then ' there is a limit to the input value... anything that requires a symbol for 5000 (D with a bar above) does not work... MMMDCCCXCIX ... 3899
Exit Function
End If
intValue = lngValue
Do While intValue > udrNumerals(6).value
intTemp = intValue
Mod udrNumerals(6).value
numRank = intTemp / udrNumerals(6).value
' this is the number of 1000s
getRomanNumeral = getRomanNumeral & udrNumerals(6).symbol
'L
intValue = intValue - udrNumerals(6).value
Loop
' now the value is less than 1000
intRank = 5
Do While intValue > 0
If intRank Mod 2 = 1 Then
' this is either 5, 50 or 500
intTemp = intValue
Mod udrNumerals(intRank).value
If intValue >= udrNumerals(intRank).value Then ' >= 5
If intValue >= udrNumerals(intRank + 1).value - udrNumerals(intRank - 1).value Then ' >= 9
getRomanNumeral = getRomanNumeral & udrNumerals(intRank - 1).symbol & udrNumerals(intRank + 1).symbol
' IX
intValue = intValue + udrNumerals(intRank - 1).value - udrNumerals(intRank + 1).value
' -1+10
ElseIf intValue >= udrNumerals(intRank).value + 3 * udrNumerals(intRank - 1).value Then ' >= 8
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol & udrNumerals(intRank - 1).symbol & udrNumerals(intRank - 1).symbol & udrNumerals(intRank - 1).symbol
' VIII
intValue = intValue - udrNumerals(intRank).value - 3 * udrNumerals(intRank - 1).value
' + 5 + 3
ElseIf intValue >= udrNumerals(intRank).value + 2 * udrNumerals(intRank - 1).value Then ' >= 7
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol & udrNumerals(intRank - 1).symbol & udrNumerals(intRank - 1).symbol
' VII
intValue = intValue - udrNumerals(intRank).value - 2 * udrNumerals(intRank - 1).value
' + 5 + 2
ElseIf intValue >= udrNumerals(intRank).value + udrNumerals(intRank - 1).value Then ' >= 6
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol & udrNumerals(intRank - 1).symbol
' VI
intValue = intValue - udrNumerals(intRank).value - udrNumerals(intRank - 1).value
' + 5 + 1
Else ' >= 5
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol
' V
intValue = intValue - udrNumerals(intRank).value
' + 5
End If
Else
intRank = intRank - 1
End If
Else
' this is either 1, 10, 100
If intValue >= udrNumerals(intRank).value Then ' >= 1 but < 5
If intValue >= udrNumerals(intRank + 1).value - udrNumerals(intRank).value Then ' >= 4
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol & udrNumerals(intRank + 1).symbol
' IV
intValue = intValue + udrNumerals(intRank).value - udrNumerals(intRank + 1).value
ElseIf intValue >= 3 * udrNumerals(intRank).value Then ' >= 3
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol & udrNumerals(intRank).symbol & udrNumerals(intRank).symbol
' III
intValue = intValue - 3 * udrNumerals(intRank).value
ElseIf intValue >= 2 * udrNumerals(intRank).value Then ' >= 2
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol & udrNumerals(intRank).symbol
' II
intValue = intValue - 2 * udrNumerals(intRank).value
Else ' >= 1
getRomanNumeral = getRomanNumeral & udrNumerals(intRank).symbol
' III
intValue = intValue - udrNumerals(intRank).value
End If
Else
intRank = intRank - 1
End If
End If
Loop
Exit Function
handler:
Stop
Resume
End Function
Public Function isARomanNumeral(ByVal strWord As String) As Boolean
' this function tests if the input is a valid roman numeral
isARomanNumeral =
False
If Len(strWord) > 0 Then
If UCase(Trim(getRomanNumeral(evaluateRomanNumeral(strWord)))) = UCase(Trim(strWord)) Then
isARomanNumeral =
True
End If
End If
End Function