VB.Net Numbers and Text

Number to Roman Numeral

Public Function NumberToRoman(number As Integer) As String
 Dim arabic() As String = Split("1000,900,500,400,100,90,50,40,10,9,5,4,1", ",", 13)
 Dim roman() As String = Split("M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I", ",", 13)
 Dim i As Integer, result As String
 result = ""
 For i = 0 To 12
  Do While number >= Val(arabic(i))
   result &= roman(i)
   number -= CInt(Val(arabic(i)))
  Loop
 Next i
 Return result
End Function

Roman Numberal to Number

Public Function RomanToNumber(roman As String) As Integer
 ' this tolerates most malformed roman variations and Roman Numerals are often malformed
 ' there is a speed penalty for tolerance but this will be fine for small sets of numerals
 roman = roman.Replace(" ", "").ToUpper
 If roman = "" Then Return 0
 Dim ret As Integer = 0
 Dim test As String
 For i As Integer = 1 To Len(roman) - 1
  test = Mid(roman, i, 2)
  Select Case test
   Case "IV", "IX", "IL", "IC", "ID", "IM" : ret -= 2 ' deduct 2 not 1 because 1 is added when next step also sees the I
   Case "VX", "VL", "VC", "VD", "VM" : ret -= 10 ' only seen in malformed numerals
   Case "XL", "XC", "XD", "XM" : ret -= 20 ' Often seen but often considered as malformed
   Case "LC", "LD", "LM" : ret -= 100' only seen in malformed numerals
   Case "CD", "CM" : ret -= 200' Often seen but often considered as malformed
   Case "DM" : ret -= 1000 ' only seen in malformed numerals
  End Select
 Next
 For Each c As Char In roman
  Select Case c
   Case "I"c : ret += 1
   Case "V"c : ret += 5
   Case "X"c : ret += 10
   Case "L"c : ret += 50
   Case "C"c : ret += 100
   Case "D"c : ret += 500
   Case "M"c : ret += 1000
  End Select
 Next
 Return ret
End Function

Number to Words

Public Function NumberToWords(num As Integer, Optional Usa As Boolean = False) As String
 Dim unit, thousand, million As Integer
 Dim answer As String = ""
 If num > 999999999 Then num = 0
 million = CInt(Int(num / 1000000))
 thousand = CInt((Int(num / 1000) Mod 1000))
 unit = num Mod 1000
 If million > 0 Then answer &= Thousand2text(million, Usa) & " million"
 If thousand > 0 Then answer &= ","
 answer &= " "
 If thousand > 0 Then answer &= Thousand2text(thousand, Usa) & " thousand"
 If unit > 0 Then answer &= ","
 answer &= " "
 If unit > 0 Then answer &= Thousand2text(unit)
 If num = 0 Then answer &= " zero"
 answer = Replace(answer, "  ", " ")
 answer = Trim(answer)
 Return answer
End Function
Private Function Thousand2text(n As Integer, Optional Usa As Boolean = False) As String
 Dim hundred As Integer = CInt(Int(n / 100))
 Dim tens As Integer = n Mod 100
 Dim words(20) As String
 Dim ans As String = ""
 Dim wordunits() As String = {"zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen", "twenty"}
 Dim wordtens() As String = {"zero", "ten", "twenty", "thirty", "fourty", "fifty", "sixty", "seventy", "eighty", "ninety", "hundred"}
 If hundred > 0 Then ans = " " & wordunits(hundred) & " "
 ans &= " hundred "
 If tens > 0 Then
  If Usa Then ans = " " Else ans = " and "
  If tens < 20 Then
   ans &= wordunits(tens)
  Else
   ans = wordtens(CInt(Int(tens / 10))) & " "
   If tens Mod 10 > 0 Then
    ans = wordunits(tens Mod 10) & " "
   End If
  End If
 End If
 Return ans
End Function

Remove non-numeric characters

Public Function RemoveNonNumeric(txt As String) As String
 Return Text.RegularExpressions.Regex.Replace(txt, "^0-9", "")
End Function

The code functions on this site are only intended as a learning aid. Data validation is often ommited to assist users unfamiliar with Visual Basic. The information may be untested, unreliable or unsuitable for your requirements. It is presented in a non-commercial form as an ex-gratia attempt to be helpful. By making any use of information contained on these pages, you agree to fully absolve and indemnify DigitalDan in relation to any issue arising out of such use.