我正在尝试根据我的需要量身定制SpellNumber功能 防爆。 1,112,589.63 =一百万个一百五十五百五十九六十三
我面临的问题是根据我目前的职能
Option Explicit
'MAIN FUNCTION
'=SPELLNUMBER(95)
Sub TEST()
MsgBox SPELLNUMBER(95)
End Sub
Function SPELLNUMBER(MYNUMBER, Optional BMONEY = False)
Dim DOLLARS, CENTS, TEMP
Dim DECIMALPLACE, COUNT
Dim INUMBER
ReDim PLACE(9) As String
PLACE(1) = " HUNDRED "
PLACE(2) = " THOUSAND "
PLACE(3) = " MILLION "
PLACE(4) = " BILLION "
PLACE(5) = " TRILLION "
INUMBER = MYNUMBER
' 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
CENTS = Right(FormatCurrency(MYNUMBER, 2), 2) & "/100"
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
If BMONEY = True Then
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
End If
SPELLNUMBER = DOLLARS & CENTS
End Function
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
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
RESULT = RESULT & GETDIGIT _
(Right(TENSTEXT, 1)) ' RETRIEVE ONES PLACE.
End If
GETTENS = RESULT
End Function
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
我在最后3个数字的末尾得到了数字HUNDRED 防爆。 1,112,589.63 =一百万个一百五十五百五十九个百分之六十三
有人可以帮助我在小数点前结束这个词吗？ 非常感谢!!!!
答案 0 :(得分：1)
您的Places变量中不需要数百个。
你将拥有的是
Ones
Thousands
Millions
...
但由于Ones无关紧要，您可以将该地点留空。
答案 1 :(得分：0)
LinearLayout答案 2 :(得分：0)
分= GetTens（左（中（MyNumber，小数位数+ 1）和“ 00”，2）） '在转换美分部分中更改为以上句子
'转换分并将MYNUMBER设置为美元。 如果DECIMALPLACE> 0然后 vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv CENTS =右（FormatCurrency（MYNUMBER，2），2）＆“ / 100” <<<
显式选项 工作簿公开活动 私人子Workbook_Open（） Application.CalculateFullRebuild 结束子 '主功能 函数ChqText（ByVal Myinput）作为字符串
Dim Temp, TempA, MyinputA, MyinputB, MyinputC As String
Dim digitvalue, integer1, integer2, Place As String
Dim digitlength, J As Integer
Place = "仙角元拾佰仟萬拾佰仟億拾佰仟萬"
integer1 = "壹貳參肆伍陸柒捌玖"
integer2 = "正整零元零零零萬零零零億零零零萬"
digitvalue = ""
If Myinput < 0 Then digitvalue = "負"
Myinput = Int(Abs(Myinput) * 100 + 0.5)
If Myinput > 999999999999999# Then
ChqText = "數字太大了！"
Exit Function
End If
If Myinput = 0 Then
ChqText = "零元零仙"
Exit Function
End If
MyinputA = Trim(Str(Myinput))
digitlength = Len(MyinputA)
For J = 1 To digitlength
MyinputB = Mid(MyinputA, J, 1) & MyinputB
Next
For J = 1 To digitlength
Temp = Val(Mid(MyinputB, J, 1))
If Temp = 0 Then
MyinputC = Mid(integer2, J, 1) & MyinputC
Else
MyinputC = Mid(integer1, Temp, 1) & Mid(Place, J, 1) & MyinputC
End If
Next
digitlength = Len(MyinputC)
For J = 1 To digitlength - 1
If Mid(MyinputC, J, 1) = "零" Then
Select Case Mid(MyinputC, J + 1, 1)
Case "零", "元", "萬", "億", "正":
MyinputC = Left(MyinputC, J - 1) & Mid(MyinputC, J + 1, 30)
J = J - 1
End Select
End If
Next
digitlength = Len(MyinputC)
For J = 1 To digitlength - 1
If Mid(MyinputC, J, 1) = "億" And Mid(MyinputC, J + 1, 1) = "萬" Then
MyinputC = Left(MyinputC, J) & Mid(MyinputC, J + 2, 30)
Exit For
End If
Next
ChqText = digitvalue & Trim(MyinputC)
结束功能
'主要功能
函数SpellNumber（ByVal MyNumber）
美元，美分，临时货币
Dim DecimalPlace，计数
ReDim Place（9）作为字符串
Place（2）=“千”
Place（3）=“百万”
Place（4）=“十亿”
Place（5）=“万亿”
'金额的字符串表示形式。
MyNumber = Trim（Str（MyNumber））
'小数点后一位的位置（如果没有）。
DecimalPlace = InStr（MyNumber，“。”）
'转换美分并将MyNumber设置为美元金额。
如果DecimalPlace> 0那么
分= GetTens（左（中（MyNumber，DecimalPlace + 1）和“ 00”，2））
MyNumber = Trim（左（MyNumber，DecimalPlace-1））
如果结束
Count = 1
当MyNumber <>“”
Temp = GetHundreds（Right（MyNumber，3））
如果温度<>“”，则美元=温度和地点（计数）和美元
如果Len（MyNumber）> 3然后
MyNumber = Left（MyNumber，Len（MyNumber）-3）
其他
MyNumber =“”
如果结束
Count = Count + 1
循环
选择案例美元
情况“”
美元=“无美元”
案例“一个”
美元=“一美元”
其他情况
美元=美元和“美元”
结束选择
选择案例分
情况“”
Cents =“ and No Cents”
案例“一个”
美分=“和1美分”
其他情况
Cents =“和”＆Cents＆“ Cents”
结束选择
SpellNumber =美元和美分
结束功能
'将100-999之间的数字转换为文本
函数GetHundreds（ByVal MyNumber）
将结果昏暗为字符串
如果Val（MyNumber）= 0，则退出函数
MyNumber = Right（“ 000”＆MyNumber，3）
'转换百位。
如果Mid（MyNumber，1，1）<>“ 0”然后
结果= GetDigit（Mid（MyNumber，1，1））＆“一百”
如果结束
'转换十位数和一位。
如果Mid（MyNumber，2，1）<>“ 0”然后
结果=结果和GetTens（Mid（MyNumber，2））
其他
结果=结果和GetDigit（Mid（MyNumber，3））
如果结束
GetHundreds =结果
结束功能
'将数字从10转换为99。
函数GetTens（TensText）
将结果昏暗为字符串
Result =“”'空出临时函数值。
如果Val（Left（TensText，1））= 1则'如果值在10-19之间...
选择大小写Val（TensText）
案例10：结果=“十”
案例11：结果=“十一”
案例12：结果=“十二”
案例13：结果=“十三”
案例14：结果=“十四”
案例15：结果=“十五”
情况16：结果=“十六”
案例17：结果=“十七”
案例18：结果=“十八”
案例19：结果=“十九”
其他情况
结束选择
否则'如果值在20-99之间...
选择大小写Val（左（TensText，1））
情况2：结果=“二十”
情况3：结果=“三十”
案例4：结果=“四十”
案例5：结果=“五十”
情况6：结果=“ 60”
案例7：结果=“七十”
案例8：结果=“八十”
案例9：结果=“九十”
其他情况
结束选择
Result = Result＆GetDigit（Right（TensText，1））'检索一个地方。
如果结束
GetTens =结果
结束功能
'将数字从1转换成9。
函数GetDigit（Digit）
选择大小写字母Val（数字）
案例1：GetDigit =“一个”
案例2：GetDigit =“ Two”
情况3：GetDigit =“三个”
案例4：GetDigit =“四个”
案例5：GetDigit =“五个”
案例6：GetDigit =“六个”
案例7：GetDigit =“ Seven”
案例8：GetDigit =“八个”
案例9：GetDigit =“ Nine”
其他情况：GetDigit =“”
结束选择
结束功能
'函数TCMny（字符串形式的Mny）作为字符串
'=========将金额数值转换成中文金额至兆位==============
'
'============================================== ===============================
'当前只转换至兆位数百万止
函数TCMny（Mny As String）As String
Dim ReturnC As String
Dim Cunit(), CunitP(), Cnumb(), MnyA() As String
Dim i, numberLen, oneN, nN, sN As Integer
Dim NP As Boolean
ReturnC = ""
'Cunit = Array("元", "拾", "佰", "仟", "萬", "拾", "佰", "仟", "億", "拾", "佰", "仟", "兆")
CunitP = Array("分", "角", ".", "元", "拾", "佰", ",", "仟", "萬", "拾", ",", "佰", "仟", "億", ",", "拾", "佰", "仟", ",", "兆", "拾", "佰", ",", "仟")
Cnumb = Array("零", "壹", "貳", "參", "肆", "伍", "陸", "柒", "捌", "玖")
'金額不格式化小數第二位零時會被省略,致使無法取得一致的格式
'所以用format產一個與CunitP相同對應的格式
Mny = Format(Mny, "#,##0.00")
'ReDim MnyA(Len(Mny) - 1)
'For i = 0 To UBound(MnyA)
' MnyA(i) = Mid(Mny, Len(Mny) - i, 1)
'Next
'MsgBox "len=" & Mny
For i = 0 To Len(Mny) - 1
'MsgBox "len=" & Len(Mny)
'不理 0 . ,
If Mid(Mny, i + 1, 1) = "." Or Mid(Mny, i + 1, 1) = "," Then
sN = i '欺騙用
Else
If Mid(Mny, i + 1, 1) <> "0" Then
ReturnC = ReturnC + Cnumb(Val(Mid(Mny, i + 1, 1)))
'MsgBox Val(Mid(Mny, i + 1, 1)) & " " & i
ReturnC = ReturnC + CunitP(Len(Mny) - i - 1)
Else
If Len(Mny) - i = 20 Then
ReturnC = ReturnC + "兆"
End If
If Len(Mny) - i = 14 Then
ReturnC = ReturnC + "億"
End If
If Len(Mny) - i = 9 Then
ReturnC = ReturnC + "萬"
End If
If Len(Mny) - i = 4 Then
ReturnC = ReturnC + "元"
End If
End If
End If
Next i
ReturnC = ReturnC + "整"
'//ShowMessage(ReturnC);
'return ReturnC;
TCMny = ReturnC
结束功能