|
Функция преобразования арабских цифр в римские
#32512956
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
Участник
Откуда: Подмосковье
Сообщения: 4 871
|
|
где нашел - не вспомню
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
Option Compare Database
Option Explicit
Public Function ArabToRim(number As Long) As String
'autor:mailto:pas_sword@tut.by
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
Public Function RimToArab(number As String) As Long
'autor:mailto:pas_sword@tut.by
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
|
|
|
