Може ли в MS Excel 2010 да се преобразува число в текст - от цифром в словом?

Question

Мразя да ми се случва така, но се случва! Веднъж на 100 години ще ми се наложи да направя нещо, което някога е минало покрай ушите ми и се чудя къде съм спал.

Краси Кръстев · Accepted Answer

Здравей,

ето един макрос който може да ти свърши работа.

Направен е за стойности във валута.

Предполагам, че за това ти трябва.

Function Spell(NumStr, i)

Static Units(20) As String, Decim(9) As String, Hundr(11) As String, Thous(5) As String, Thous1(5) As String

Static Units1(20) As String

Units(0) = ""

Units(1) = "един "

Units(2) = "два "

Units(3) = "три "

Units(4) = "четири "

Units(5) = "пет "

Units(6) = "шест "

Units(7) = "седем "

Units(8) = "осем "

Units(9) = "девет "

Units(10) = "десет "

Units(11) = "единадесет "

Units(12) = "дванадесет "

Units(13) = "тринадесет "

Units(14) = "четиринадесет "

Units(15) = "петнадесет "

Units(16) = "шестнадесет "

Units(17) = "седемнадесет "

Units(18) = "осемнадесет "

Units(19) = "деветнадесет "

Units1(0) = ""

Units1(1) = "една "

Units1(2) = "две "

Units1(3) = "три "

Units1(4) = "четири "

Units1(5) = "пет "

Units1(6) = "шест "

Units1(7) = "седем "

Units1(8) = "осем "

Units1(9) = "девет "

Units1(10) = "десет "

Units1(11) = "единадесет "

Units1(12) = "дванадесет "

Units1(13) = "тринадесет "

Units1(14) = "четиринадесет "

Units1(15) = "петнадесет "

Units1(16) = "шестнадесет "

Units1(17) = "седемнадесет "

Units1(18) = "осемнадесет "

Units1(19) = "деветнадесет "

Decim(0) = ""

Decim(1) = "двадесет "

Decim(2) = "тридесет "

Decim(3) = "четиридесет "

Decim(4) = "петдесет "

Decim(5) = "шестдесет "

Decim(6) = "седемдесет "

Decim(7) = "осемдесет "

Decim(8) = "деведесет "

Hundr(0) = ""

Hundr(1) = ""

Hundr(2) = "сто "

Hundr(3) = "двеста "

Hundr(4) = "триста "

Hundr(5) = "четиристотин "

Hundr(6) = "петстотин "

Hundr(7) = "шестстотин "

Hundr(8) = "седемстотин "

Hundr(9) = "осмстотин "

Hundr(10) = "деветстотин "

Thous(0) = ""

Thous(1) = ""

Thous(2) = "хиляди "

Thous(3) = "милиона "

Thous(4) = "милиарда "

Thous1(0) = ""

Thous1(1) = ""

Thous1(2) = "хиляда "

Thous1(3) = "милион "

Thous1(4) = "милиард "

Dim Num, RetStr

RetStr = ""

Num = CInt(NumStr)

If Num = 0 Then

Spell = RetStr

Exit Function

End If

If Num = 1 Then

Select Case i

Case 1

RetStr = "и " & Units(1) & Thous1(1)

Case 2

RetStr = Thous1(2)

Case Else

RetStr = Units(1) & Thous1(i)

End Select

Spell = RetStr

Exit Function

End If

RetStr = RetStr & "и " & Hundr(CInt(Left(NumStr, 1)) + 1)

If CInt(Right(NumStr, 2)) = 0 Then

Spell = RetStr & Thous(i)

Exit Function

End If

If Mid(NumStr, 2, 1) = "0" Or Mid(NumStr, 2, 1) = "1" Then

If i = 2 Then

Spell = RetStr & "и " & Units1(CInt(Mid(NumStr, 2, 2))) & Thous(i)

Else

Spell = RetStr & "и " & Units(CInt(Mid(NumStr, 2, 2))) & Thous(i)

End If

Exit Function

End If

If Right(NumStr, 1) = "0" Then

RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1)

Else

If i = 2 Then

RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1) & "и " & Units1(CInt(Right(NumStr, 1)))

Else

RetStr = RetStr & Decim(CInt(Mid(NumStr, 2, 1)) - 1) & "и " & Units(CInt(Right(NumStr, 1)))

End If

Spell = RetStr & Thous(i)

End Function

Function Slov(ByVal Num As Currency)

Static c(5)

Dim NumStr, NumStr1, i, k

If Not IsNull(Num) Then

NumStr = Trim(CStr(Num))

If Num = 0 Then

Slov = "нула"

Exit Function

End If

Dim Buf As String:

If (Num < 0@) Then Buf = "минус " Else Buf = ""

Dim Frac As Currency: Frac = Abs(Num - Fix(Num))

If (Num < 0@ Or Frac <> 0@) Then Num = Abs(Fix(Num))

Dim AtLeastOne As Integer: AtLeastOne = Num >= 1

i = 1

NumStr = Num

Do

If Len(NumStr) > 3 Then

c(i) = Right$(NumStr, 3)

NumStr = Left$(NumStr, Len(NumStr) - 3)

i = i + 1

Else

c(i) = String(3 - Len(NumStr), "0") & NumStr

Exit Do

End If

Loop

NumStr = ""

For k = i To 1 Step -1

NumStr = NumStr & Spell(c(k), k)

Next k

Debug.Print NumStr

If Left(NumStr, 2) = "и " Then

NumStr = Right$(NumStr, Len(NumStr) - 2)

End If

If Left(NumStr, 2) = "и " Then

NumStr = Right$(NumStr, Len(NumStr) - 2)

End If

'стотинки

If (Frac = 0@) Then

Buf = Buf

ElseIf (Int(Frac * 100@) = Frac * 100@) Then

If AtLeastOne Then Buf = Buf & "и "

Buf = Buf & Format$(Frac * 100@, "00")

Else

If AtLeastOne Then Buf = Buf & "и "

Buf = Buf & Format$(Frac * 10000@, "0000")

End If

Slov = NumStr & Buf ' "лв. "

End If

End Function

Дарина Иванова · Answer

Намерих линк с код за преобразуване на числа в текст: https://uroci.net/urok/1798/%D0%98%D0%B7%D0%BF%D0%B8%D1%81%D0%B2%D0%B0%D0%BD%D0%B5-%D0%BD%D0%B0-%D1%87%D0%B8%D1%81%D0%BB%D0%BE-%D1%81-%D0%B4%D1%83%D0%BC%D0%B8.html

google.com

Стефан Петров Петров · Answer

Здравей Краси ! Ползвам този макрос, но има ли начин да го заредя за целия Excel така че, не всеки път като отварям програмата да трябва да го зареждам за конкретния файл?

Тантан · Answer

Може - зареди го(макроса) в Personal.xls( или PERSONAL.XLSB), ако нямаш такъв файл - създай си го с EXCEL!

Краси Кръстев · Answer

Здравей, Стефане.

Вариант е да си направиш един Tempalate ( същото е както и в Word ) и когато имаш такава задачка да си тръгваш от този tempalate.

Стефан Петров Петров · Answer

И аз така правя...ама мислех че има като при Аутокад да го заредиш и да се ползва постоянно.

Симеон Симеонов · Answer

СТРАХОТНИ СТЕ ХОРА. Работи перфектно. Уникален проект!

Краси Кръстев · Answer

Здравей, Симеон Симеонов.

Супер е, че ти е полезно!

Стефан Петров Петров · Answer

Този код може ли да се бутне в ексел
https://gist.github.com/wqweto/d7ca68a5fd0368c08158

Краси Кръстев · Answer

@ Стефан. Не би трябвало да има проблем. Този който е постна по-горе мисля че ще ти свърши работа.

Стефан Петров Петров · Answer

Да Краси ! Аз него си го ползвам :)  Честит рожден ден, Краси Жив и здрав

Краси Кръстев · Answer

Супер е че ти върши работа.

Благодаря за пожеланието!

Стефан Петров Петров · Answer

Хм нещо не мога да го запиша като template.??? записва нещо после като отворя няма нищо. Ще помогне ли някой със стъпките на записа...

Стефан Петров Петров · Answer

Следвах всичко по тази страница https://www.ablebits.com/office-addins-blog/2013/12/06/add-run-vba-macro-excel/
когато трябва да отворя макроса , бутоните са ми неактивни не знам защо???

Ginka Yankova · Answer

Как да изпише стотинките дава ми грешка тук

Ginka Yankova · Answer

'стотинки
If (Frac = 0@) Then
Buf = Buf
ElseIf (Int(Frac * 100@) = Frac * 100@) Then
If AtLeastOne Then Buf = Buf & "и "
Buf = Buf & Format$(Frac * 100@, "00")
Else
If AtLeastOne Then Buf = Buf & "и "
Buf = Buf & Format$(Frac * 10000@, "0000")
End If
Slov = NumStr & Buf ' "лв. "
End If
End Function

Elvan Mehmed · Answer

Здравейте, пробвах тази функция в макроса,но цифрите,изписани на кирилица излизат като въпросителни:????
Как мога да го променя,че да ми излизат цифрите на бълг език?

Може ли в MS Excel 2010 да се преобразува число в текст - от цифром в словом?

Вашият отговор