该功能应该使您可以将美元和美分金额转换为带有公式的单词,因此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
答案 0 :(得分:1)
您重新格式化了代码。 _
字符表示新的代码行,该代码行从上一行继续,没有其他换行符。您要么删除了换行符,要么完全将_
字符放错了位置。
'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.
答案 1 :(得分:1)
我写了新代码。
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