| |
Автор: P@Ssword
Две функции, позволяющие переводить числа из арабских в римские.
Private Function ArabToRim(Number As Long) As String
Dim Ary()
Dim Num As Long
Dim Str As String
Dim Res As String
Dim Ind As Long
Ary = Array(1000, "M", 900, "CM", 500, "D", 400, "CD", _
100, "C", 90, "XC", 50, "L", 40, "XL", _
10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I")
While Number > 0
For Ind = 0 To UBound(Ary) - 1 Step 2
Num = Ary(Ind)
Str = Ary(Ind + 1)
While Num <= Number
Res = Res & Str
Number = Number - Num
Wend
Next Ind
Wend
ArabToRim = Res
End Function
Private Function RimToArab(Number As String) As Long
Dim Ary()
Dim Num As Long
Dim Str As String
Dim Res As Long
Dim Ind As Long
Ary = Array(1000, "M", 900, "CM", 500, "D", 400, "CD", _
100, "C", 90, "XC", 50, "L", 40, "XL", _
10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I")
While Len(Number) > 0
For Ind = 0 To UBound(Ary) - 1 Step 2
Num = Ary(Ind)
Str = Ary(Ind + 1)
While Str = Left$(Number, Len(Str))
Res = Res + Num
Number = Right$(Number, Len(Number) - Len(Str))
Wend
Next Ind
Wend
RimToArab = Res
End Function
|
|