Почему мой номер в текстовый код не работает? - PullRequest
0 голосов
/ 12 января 2019

Предполагается, что эта функция позволяет конвертировать суммы в долларах и центах в слова с формулой, поэтому 22,50 будут читаться как двадцать два доллара и пятьдесят центов. Формула для этого = SpellNumber (A1)

Кажется, у меня проблемы. Я получил этот код прямо с веб-сайта Microsoft, поэтому не понимаю, почему он не будет работать. Я совсем новичок в VBA и был бы признателен за некоторые советы, чтобы это исправить. Заранее благодарю за помощь!

     Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

Dim Dollars, Cents, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Million "

Place(4) = " Billion "

Place(5) = " Trillion "

' String representation of amount.

MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none.

DecimalPlace = InStr(MyNumber, ".")

' Convert cents and set MyNumber to dollar amount.

If DecimalPlace > 0 Then
' <-- Edit: remove incorrect line break = underscore character -->
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Dollars

Case ""

Dollars = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Dollars & Cents

End Function


' Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

' Convert the hundreds place.

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If

' Convert the tens and ones place.

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If

GetHundreds = Result

End Function


' Converts a number from 10 to 99 into text.


 Function GetTens(TensText)

Dim Result As String

Result = "" ' Null out the temporary function value.

If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...

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 ' If value between 20-99...

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
' <-- Edit incorrect line break -->
Result = Result & GetDigit _

(Right(TensText, 1)) ' Retrieve ones place. 

End If

GetTens = Result

End Function


 ' Converts a number from 1 to 9 into text.

 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

Ответы [ 2 ]

0 голосов
/ 14 января 2019

Я написал новый код.

Function NumbertoString(sNum As String)
    Dim s As String
    Dim vDigit(), vR(), vMod()
    Dim Digit1000
    Dim sDal As String, sCent As String
    Dim Cent As String, Num As String
    Dim i As Integer, x As Integer, k As Integer

    If InStr(sNum, ".") Then
        s = Split(sNum, ".")(0)
        Cent = Split(sNum, ".")(1)
    Else
        s = sNum
        Cent = ""
    End If

    Digit1000 = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
    k = Len(s)
    x = k Mod 3
    n = Int(k / 3)
    If n = 0 Then GoTo p
    ReDim vDigit(1 To n)

    '@@If the length of the number is a multiple of 3
    For i = 1 To n
        st = k - i * 3 + 1
        vDigit(i) = Mid(s, st, 3)
    Next i
    '@@If the length of the number is NOT a multiple of 3
p:
    If x > 0 Then
        n = n + 1
        ReDim Preserve vDigit(1 To n)
        vDigit(n) = Left(s, x)
    End If
    For i = n To 1 Step -1
          Num = Num & getString(vDigit(i)) & Digit1000(i)
    Next i
    Select Case Num
        Case ""
            sDal = " No Dallar "
        Case "One"
            sDal = " Dallar "
        Case Else
            sDal = " Dallars "
    End Select

    Select Case getString(Val(Cent))
        Case ""
            sCent = "and No Cents"
        Case "One"
            sCent = " Cent"
        Case Else
            sCent = " Cents"
    End Select
    NumbertoString = Num & sDal & " and " & getString(Val(Cent)) & sCent
End Function

Function getString(s)
    Dim vDigit(), vR(), vMod()
    Dim n As Integer, i As Long
    Dim Num As String

    dig1 = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    dig10 = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    dig20 = Array("", "", "Twenty ", "Thirty ", "Forty ", "Fitty ", "Sixty ", "Seventy ", "Eighty", "Ninety ")
    If s = "" Then Exit Function
    Do Until (s / 10) < i
        n = n + 1
        i = 10 ^ n
        ReDim Preserve vDigit(1 To n)
        vDigit(n) = i
    Loop
    ReDim vMod(1 To n)
    For i = 1 To n
        vMod(i) = s Mod vDigit(i)
    Next i
    ReDim vR(1 To n + 1)

    vR(1) = vMod(1)
    For i = 2 To n
        vR(i) = Int((vMod(i) - vMod(i - 1)) / vDigit(i - 1))
    Next i
    vR(n + 1) = Int((s - vMod(n)) / vDigit(n))

    Select Case vR(2)
        Case 0
            Num = dig1(vR(1))
        Case 1
            Num = dig10(vR(1))
        Case Else
            Num = dig20(vR(2)) & dig1(vR(1))
    End Select
    If UBound(vR) = 3 Then
        Num = dig1(vR(3)) & " Hundred " & Num
    End If
    getString = Num
End Function

изображение результата enter image description here

0 голосов
/ 12 января 2019

Вы неправильно отформатировали код. Символ _ отмечает новую строку кода, которая продолжается с предыдущей без дополнительных переводов строки. Вы либо удалили перевод строки, либо вообще не поместили символ _.

'This,
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2))

'should have been,
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
'or,
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
   "00", 2))


'This,
Result = Result & GetDigit _

(Right(TensText, 1)) ' Retrieve ones place.

'should have been,
Result = Result & GetDigit(Right(TensText, 1)) ' Retrieve ones place.
'or,
Result = Result & GetDigit _
   (Right(TensText, 1)) ' Retrieve ones place.
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...