Сумма прописью в excel

← →
Ищу (2004-10-08 16:14) [0]

А есть ли в Excel"e функция, переводящая сумму в строку
22,2 - > двадцать два рубля двадцать копеек.

← →
Digitman © (2004-10-08 16:27) [1]

носи не стаптывай :

Public Function Сумма_прописью(Summa As Double, HideCentIfZero As Boolean) As String
Static Init As Boolean
Static MR(0 To 4) As String
Static MA(0 To 4, 0 To 9) As String
Static TR(0 To 2, 0 To 9) As String
Static Ex(0 To 2, 0 To 9) As String

If Summa <= 0 Or Summa > 999999999999.99 Then Exit Function

If Not Init Then
MR(0) = "копе"
MR(1) = "рубл"
MR(2) = "тысяч"
MR(3) = "миллион"
MR(4) = "миллиард"
TR(0, 0) = ""
TR(0, 1) = "од"
TR(0, 2) = "дв"
TR(0, 3) = "три"
TR(0, 4) = "четыр"
TR(0, 5) = "пят"
TR(0, 6) = "шест"
TR(0, 7) = "сем"
TR(0, 8) = "восем"
TR(0, 9) = "девят"
TR(1, 0) = ""
TR(1, 1) = "десять"
TR(1, 2) = "двадцать"
TR(1, 3) = "тридцать"
TR(1, 4) = "сорок"
TR(1, 5) = "пятьдесят"
TR(1, 6) = "шестьдесят"
TR(1, 7) = "семьдесят"
TR(1, 8) = "восемьдесят"
TR(1, 9) = "девяносто"
TR(2, 0) = ""
TR(2, 1) = "сто"
TR(2, 2) = "двести"
TR(2, 3) = "триста"
TR(2, 4) = "четыреста"
TR(2, 5) = "пятьсот"
TR(2, 6) = "шестьсот"
TR(2, 7) = "семьсот"
TR(2, 8) = "восемьсот"
TR(2, 9) = "девятьсот"
MA(0, 0) = "ек"
MA(0, 1) = "йка"
MA(0, 2) = "йки"
MA(0, 3) = "йки"
MA(0, 4) = "йки"
MA(0, 5) = "ек"
MA(0, 6) = "ек"
MA(0, 7) = "ек"
MA(0, 8) = "ек"
MA(0, 9) = "ек"
MA(1, 0) = "ей"
MA(1, 1) = "ь"
MA(1, 2) = "я"
MA(1, 3) = "я"
MA(1, 4) = "я"
MA(1, 5) = "ей"
MA(1, 6) = "ей"
MA(1, 7) = "ей"
MA(1, 8) = "ей"
MA(1, 9) = "ей"
MA(2, 0) = ""
MA(2, 1) = "а"
MA(2, 2) = "и"
MA(2, 3) = "и"
MA(2, 4) = "и"
MA(2, 5) = ""
MA(2, 6) = ""
MA(2, 7) = ""
MA(2, 8) = ""
MA(2, 9) = ""
MA(3, 0) = "ов"
MA(3, 1) = ""
MA(3, 2) = "а"
MA(3, 3) = "а"
MA(3, 4) = "а"
MA(3, 5) = "ов"
MA(3, 6) = "ов"
MA(3, 7) = "ов"
MA(3, 8) = "ов"
MA(3, 9) = "ов"
MA(4, 0) = "ов"
MA(4, 1) = ""
MA(4, 2) = "а"
MA(4, 3) = "а"
MA(4, 4) = "а"
MA(4, 5) = "ов"
MA(4, 6) = "ов"
MA(4, 7) = "ов"
MA(4, 8) = "ов"
MA(4, 9) = "ов"
Ex(0, 0) = ""
Ex(0, 1) = "иннадцать"
Ex(0, 2) = "енадцать"
Ex(0, 3) = "надцать"
Ex(0, 4) = "надцать"
Ex(0, 5) = "надцать"
Ex(0, 6) = "надцать"
Ex(0, 7) = "надцать"
Ex(0, 8) = "надцать"
Ex(0, 9) = "надцать"
Ex(1, 0) = ""
Ex(1, 1) = "ин"
Ex(1, 2) = "а"
Ex(1, 3) = ""
Ex(1, 4) = "е"
Ex(1, 5) = "ь"
Ex(1, 6) = "ь"
Ex(1, 7) = "ь"
Ex(1, 8) = "ь"
Ex(1, 9) = "ь"
Ex(2, 0) = ""
Ex(2, 1) = "на"
Ex(2, 2) = "е"
Ex(2, 3) = ""
Ex(2, 4) = "е"
Ex(2, 5) = "ь"
Ex(2, 6) = "ь"
Ex(2, 7) = "ь"
Ex(2, 8) = "ь"
Ex(2, 9) = "ь"
Init = True
End If

Dim TxtRps As String
Dim i As Integer, j As Integer, k As Integer
Dim R(0 To 2) As Integer
Dim Acc As String, d As String
TxtRps = Format(Summa, "000000000000.00")
TxtRps = Left(TxtRps, 12) & "0" & Right(TxtRps, 2)

For j = 4 To 0 Step -1
For i = 2 To 0 Step -1
R(i) = Mid(TxtRps, 15 - j * 3 - i, 1)
Next i
If j > 0 Then
Acc = TR(2, R(2))
Else
Acc = ""
If HideCentIfZero And R(1) = 0 And R(0) = 0 Then Exit For
End If
If R(1) <> 1 Or R(0) = 0 Then
If j > 0 Then
Acc = Trim(Acc & " " & TR(1, R(1)))
Acc = Trim(Acc & " " & TR(0, R(0)))
Else
Acc = Trim(Acc & " " & R(1) & R(0))
End If
If j = 0 Or j = 2 Then k = 2 Else k = 1
Else
If j > 0 Then
Acc = Trim(Acc & " " & TR(0, R(0)))
Else
Acc = Trim(Acc & " " & R(1) & R(0))
End If
k = 0
End If
If Acc <> "" Or (j = 1 And Сумма_прописью <> "") Then
If j = 0 Then d = "" Else d = Ex(k, R(0))
Acc = Trim(Acc & d & " " & MR(j))
If k <> 0 Then k = R(0)
Acc = Acc & MA(j, k)
End If
Сумма_прописью = Trim(Сумма_прописью & " " & Acc)
Next j
Сумма_прописью = UCase(Left(Сумма_прописью, 1)) & Mid(Сумма_прописью, 2)

End Function

Сумма прописью в excel Найти похожие ветки