VBA помощь!
19 февраля 2015 - 18:01 #1
Более чем богоподобный   Сообщений: 1036 , Симпатий: 86 , Трофеев: 17
-11
Собственно нужна помощь.Как удалить из печати на экран 0 в конце каждого вывода?.
Собственно код:
Function Propis(Amount As String, Optional Money As String = "RUB", Optional lang As String = "RU", Optional Prec As Integer = 1)
 Dim whole As Double
  
 Amount = Replace(Amount, "-", Application.International(xlDecimalSeparator))
 Amount = Replace(Amount, ".", Application.International(xlDecimalSeparator))
 Amount = Replace(Amount, ",", Application.International(xlDecimalSeparator))
  
 Sum = WorksheetFunction.Round(CDbl(Amount), 2)
 Money = UCase(Money)
 lang = UCase(lang)
 whole = Int(Sum)
 fraq = Format(Round((Sum - whole) * 100), "")
  
 Select Case Class(whole, 1) + Class(whole, 2) * 10
 Case 1, 21, 31, 41, 51, 61, 71, 81, 91
 w_rus_r = ""
 w_rus_d = "äîëëàð"
 w_rus_e = "åâðî"
 w_en_r = "rubles"
 w_en_d = "dollars"
 w_en_e = "euro"
 
 Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94
 w_rus_r = ""
 w_rus_d = "äîëëàðà"
 w_rus_e = "åâðî"
 w_en_r = "rubles"
 w_en_d = "dollars"
 w_en_e = "euro"
 
 Case Else
 w_rus_r = ""
 w_rus_d = "äîëëàðîâ"
 w_rus_e = "åâðî"
 w_en_r = "rubles"
 w_en_d = "dollars"
 w_en_e = "euro"
 
 End Select
 
 Select Case fraq
 Case 1, 21, 31, 41, 51, 61, 71, 81, 91
 f_rus_r = ""
 f_rus_d = "öåíò"
 f_rus_e = "öåíò"
 f_rus_p = "ñîòàÿ"
 f_en_r = "kopecks"
 f_en_d = "cents"
 f_en_e = "cents"
 f_en_e = "cents"
 
 Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94
 f_rus_r = ""
 f_rus_d = "öåíòà"
 f_rus_e = "öåíòà"
 f_en_r = "kopecks"
 f_en_d = "cents"
 f_en_e = "cents"
 Case Else
 f_rus_r = ""
 f_rus_d = "öåíòîâ"
 f_rus_e = "öåíòîâ"
 f_en_r = "kopecks"
 f_en_d = "cents"
 f_en_e = "cents"
 End Select
 
 If Prec = 0 Then
 fraq = ""
 f_rus_r = ""
 f_rus_d = ""
 f_rus_e = ""
 f_en_r = ""
 f_en_d = ""
 f_en_e = ""
 End If
  
 If lang = "RU" Then
 Select Case Money
 Case "RUB"
 Out = ScriptRus(whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r
 Case "USD"
 Out = ScriptRus(whole) & " " & w_rus_d & " " & fraq & " " & f_rus_d
 Case "EUR"
 Out = ScriptRus(whole) & " " & w_rus_e & " " & fraq & " " & f_rus_e
 End Select
 End If
 
 If lang = "EN" Then
 Select Case Money
 Case "RUB"
 Out = ScriptEng(whole) & " " & w_en_r & " " & fraq & " " & f_en_r
 Case "USD"
 Out = ScriptEng(whole) & " " & w_en_d & " " & fraq & " " & f_en_d
 Case "EUR"
 Out = ScriptEng(whole) & " " & w_en_e & " " & fraq & " " & f_en_e
 End Select
 End If
 
 Propis = WorksheetFunction.Trim(Out)
 
End Function
 
 
Private Function Class(m, i)
 Class = Int(Int(m - (10 ^ i) * Int(m / (10 ^ i))) / 10 ^ (i - 1))
End Function
 
Private Function ScriptRus(n As Double) As String
 Dim Nums1, Nums2, Nums3, Nums4 As Variant
 Nums1 = Array("", "îäèí ", "äâà ", "òðè ", "÷åòûðå ", "ïÿòü ", "øåñòü ", "ñåìü ", "âîñåìü ", "äåâÿòü ")
 Nums2 = Array("", "äåñÿòü ", "äâàäöàòü ", "òðèäöàòü ", "ñîðîê ", "ïÿòüäåñÿò ", "øåñòüäåñÿò ", "ñåìüäåñÿò ", "âîñåìüäåñÿò ", "äåâÿíîñòî ")
 Nums3 = Array("", "ñòî ", "äâåñòè ", "òðèñòà ", "÷åòûðåñòà ", "ïÿòüñîò ", "øåñòüñîò ", "ñåìüñîò ", "âîñåìüñîò ", "äåâÿòüñîò ")
 Nums4 = Array("", "îäíà ", "äâå ", "òðè ", "÷åòûðå ", "ïÿòü ", "øåñòü ", "ñåìü ", "âîñåìü ", "äåâÿòü ")
 Nums5 = Array("äåñÿòü ", "îäèííàäöàòü ", "äâåíàäöàòü ", "òðèíàäöàòü ", "÷åòûðíàäöàòü ", "ïÿòíàäöàòü ", "øåñòíàäöàòü ", "ñåìíàäöàòü ", "âîñåìíàäöàòü ", "äåâÿòíàäöàòü ")
 
 If n = 0 Then
 ScriptRus = ""
 Exit Function
 End If
 ed = Class(n, 1)
 dec = Class(n, 2)
 sot = Class(n, 3)
 tys = Class(n, 4)
 dectys = Class(n, 5)
 sottys = Class(n, 6)
 mil = Class(n, 7)
 decmil = Class(n, 8)
 sotmil = Class(n, 9)
 mlrd = Class(n, 10)
  
 If mlrd > 0 Then
 Select Case mlrd
 Case 1
 mlrd_txt = Nums1(mlrd) & "ìèëëèàðä "
 Case 2, 3, 4
 mlrd_txt = Nums1(mlrd) & "ìèëëèàðäà "
 Case 5 To 20
 mlrd_txt = Nums1(mlrd) & "ìèëëèàðäîâ "
 End Select
 End If
 If (sotmil + decmil + mil) > 0 Then
 sotmil_txt = Nums3(sotmil)
 
 Select Case decmil
 Case 1
 mil_txt = Nums5(mil) & "ìèëëèîíîâ "
 GoTo www
 Case 2 To 9
 decmil_txt = Nums2(decmil)
 End Select
 
 Select Case mil
 Case 1
 mil_txt = Nums1(mil) & "ìèëëèîí "
 Case 2, 3, 4
 mil_txt = Nums1(mil) & "ìèëëèîíà "
 Case 0, 5 To 20
 mil_txt = Nums1(mil) & "ìèëëèîíîâ "
 End Select
 End If
www:
 sottys_txt = Nums3(sottys)
 Select Case dectys
 Case 1
 tys_txt = Nums5(tys) & "òûñÿ÷ "
 GoTo eee
 Case 2 To 9
 dectys_txt = Nums2(dectys)
 End Select
 
 Select Case tys
 Case 0
 If dectys > 0 Then tys_txt = Nums4(tys) & "òûñÿ÷ "
 Case 1
 tys_txt = Nums4(tys) & "òûñÿ÷à "
 Case 2, 3, 4
 tys_txt = Nums4(tys) & "òûñÿ÷è "
 Case 5 To 9
 tys_txt = Nums4(tys) & "òûñÿ÷ "
 End Select
 If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " òûñÿ÷ "
eee:
 sot_txt = Nums3(sot)
 
 Select Case dec
 Case 1
 ed_txt = Nums5(ed)
 GoTo rrr
 Case 2 To 9
 dec_txt = Nums2(dec)
 End Select
 
 ed_txt = Nums1(ed)
rrr:
 
 ScriptRus = mlrd_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
 ScriptRus = UCase(Left(ScriptRus, 1)) & LCase(Mid(ScriptRus, 2, Len(ScriptRus) - 1))
 End Function
 
Private Function ScriptEng(ByVal Number As Double)
 Dim BigDenom As String, Temp As String
 Dim Count As Integer
  
 ReDim Place(9) As String
 Place(2) = " Thousand "
 Place(3) = " Million "
 Place(4) = " Billion "
 Place(5) = " Trillion "
  
 strAmount = Trim(Str(Int(Number)))
  
 Count = 1
 Do While strAmount <> ""
 Temp = GetHundreds(Right(strAmount, 3))
 If Temp <> "" Then BigDenom = Temp & Place(Count) & BigDenom
 If Len(strAmount) > 3 Then
 strAmount = Left(strAmount, Len(strAmount) - 3)
 Else
 strAmount = ""
 End If
 Count = Count + 1
 Loop
 Select Case BigDenom
 Case ""
 BigDenom = " "
 Case "One"
 BigDenom = " "
 Case Else
 BigDenom = BigDenom & " "
 End Select
 ScriptEng = BigDenom
 
End Function
 
Private Function GetHundreds(ByVal MyNumber)
 Dim result As String
 If Val(MyNumber) = 0 Then Exit Function
 MyNumber = Right("" & MyNumber, 3)
 
 If Mid(MyNumber, 1, 1) <> "" Then
 result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
 End If
 
 If Mid(MyNumber, 1, 1) <> "" And (Mid(MyNumber, 2, 1) <> "" Or Mid(MyNumber, 3, 1) <> "") Then
 result = result & "And "
 End If
 
 
 If Mid(MyNumber, 2, 1) <> "" Then
 result = result & GetTens(Mid(MyNumber, 2))
 Else
 result = result & GetDigit(Mid(MyNumber, 3))
 End If
 GetHundreds = result
End Function
 
Private Function GetTens(TensText)
 Dim result As String
 result = ""
 If Val(Left(TensText, 1)) = 1 Then
 Select Case Val(TensText)
 Case 10: result = "Ten"
 Case 11: result = "Eleven"
 Case 12: result = "Twelve"
 Case 13: result = "Thirteen"
 Case 14: result = "Fourteen"
 Case 15: result = "Fifteen"
 Case 16: result = "Sixteen"
 Case 17: result = "Seventeen"
 Case 18: result = "Eighteen"
 Case 19: result = "Nineteen"
 Case Else
 End Select
 Else
 Select Case Val(Left(TensText, 1))
 Case 2: result = "Twenty "
 Case 3: result = "Thirty "
 Case 4: result = "Forty "
 Case 5: result = "Fifty "
 Case 6: result = "Sixty "
 Case 7: result = "Seventy "
 Case 8: result = "Eighty "
 Case 9: result = "Ninety "
 Case Else
 End Select
 result = result & GetDigit _
 (Right(TensText, 1))
 End If
 GetTens = result
End Function
 
Private Function GetDigit(Digit)
 Select Case Val(Digit)
 Case 1: GetDigit = "One"
 Case 2: GetDigit = "Two"
 Case 3: GetDigit = "Three"
 Case 4: GetDigit = "Four"
 Case 5: GetDigit = "Five"
 Case 6: GetDigit = "Six"
 Case 7: GetDigit = "Seven"
 Case 8: GetDigit = "Eight"
 Case 9: GetDigit = "Nine"
 Case Else: GetDigit = ""
 End Select
End Function
Сообщение отредактировал FaNaTiK2495 19 февраля 2015 - 21:10
19 февраля 2015 - 18:45 #2
Прародитель живого   Сообщений: 5940 , Симпатий: 1503 , Трофеев: 33
@Iline, это скриптовый язык для Office
19 февраля 2015 - 18:54 #3
Более чем богоподобный   Сообщений: 1036 , Симпатий: 86 , Трофеев: 17
-11
@KriBetko, VBA если быть ещё точнее.
19 февраля 2015 - 18:55 #4
Прародитель живого   Сообщений: 5940 , Симпатий: 1503 , Трофеев: 33
@saiberpro, а то юзер @Iline такой тупой, что в заголовке не прочитал.
Ты лучше покажи, где вывод.

*Подумал и через 3 минуты, 24 секунды добавил:*

Это вывод?

If lang = "RU" Then
Select Case Money
Case "RUB"
Out = ScriptRus(whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r
Case "USD"
Out = ScriptRus(whole) & " " & w_rus_d & " " & fraq & " " & f_rus_d
Case "EUR"
Out = ScriptRus(whole) & " " & w_rus_e & " " & fraq & " " & f_rus_e
End Select
End If

If lang = "EN" Then
Select Case Money
Case "RUB"
Out = ScriptEng(whole) & " " & w_en_r & " " & fraq & " " & f_en_r
Case "USD"
Out = ScriptEng(whole) & " " & w_en_d & " " & fraq & " " & f_en_d
Case "EUR"
Out = ScriptEng(whole) & " " & w_en_e & " " & fraq & " " & f_en_e
End Select
End If

Тут нулям неоткуда браться.
20 февраля 2015 - 07:49 #5
Более чем богоподобный   Сообщений: 1036 , Симпатий: 86 , Трофеев: 17
-11
@KriBetko, Нет насколько я понел это кейся для выбора языка перевода денег..
20 февраля 2015 - 08:21 #6
Я — закон!   Сообщений: 5468 , Симпатий: 2633 , Трофеев: 35
@saiberpro, тебя не смущает, что это игровой портал? Задай свой вопрос на сайте своей тематики.
"Демократия зло"
Вас забанили модераторы? Ничего личного, просто работа...
Если Вы не пользуетесь при продаже/покупке/обмене услугой гаранта от нашего сайта - скорей всего Вас кинут. empathy
20 февраля 2015 - 08:33 #7
Прародитель живого   Сообщений: 5940 , Симпатий: 1503 , Трофеев: 33
Цитата: saiberpro
@KriBetko, Нет насколько я понел это кейся для выбора языка перевода денег..

А переменная Out должны быть тем самым выводом. Я не вижу, где ты там нули увидел.

@Skipart, его там сразу в шею погонят, за такие глупые вопросы.
20 февраля 2015 - 09:05 #8
Более чем богоподобный   Сообщений: 1036 , Симпатий: 86 , Трофеев: 17
-11
@KriBetko, В том то и дело что все жизненно важные нули я не стал трогать,а остальные удалил.Но всё равно он выводит вконце строки 0.
20 февраля 2015 - 09:06 #9
Прародитель живого   Сообщений: 5940 , Симпатий: 1503 , Трофеев: 33
@saiberpro, покажи. Я не буду ставить Оффис ради этого.
  • Статистика форума:
    Всего участников: 774599 Участников онлайн: 709 (показать) Новый участник: LegendaryGoofy
    Создано тем: 65228 Всего сообщений: 902801