怎样用自定义函数将阿拉伯数字金额转换为英文会计金额，如：123.45 变为：One Hundred Twenty Three Dollars and Forty Five Cents
A：按Alt+F11，插入→模块→在VBE窗口中输入以下代码：
1.Function SpellNumber(ByValMyNumber) 2. Dim Dollars, Cents, Temp 3. Dim DecimalPlace, Count 4. ReDim Place(9) As String 5. Application.Volatile True 6. Place(2) = \" Thousand \" 7. Place(3) = \" Million \" 8. Place(4) = \" Billion \" 9. Place(5) = \" Trillion \" \' String representation of amount 10. MyNumber = Trim(Str(MyNumber)) \' Position of decimal place 0 if none 11. DecimalPlace = InStr(MyNumber, \".\") 12. \'Convert cents and set MyNumber to dollar amount 13. If DecimalPlace> 0 Then 14. Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & \"00\", 2)) 15. MyNumber = Trim(Left(MyNumber, DecimalPlace3) 23. Else 24. MyNumber = \"\" 25. End If 26. Count = Count + 1 27. Loop 28. Select Case Dollars 29. Case \"\" 30. Dollars = \"No Dollars\" 31. Case \"One\" 32. Dollars = \"One Dollar\" 33. Case Else 34. Dollars = Dollars & \" Dollars\" 35. End Select 36. Select Case Cents 37. Case \"\" 38. Cents = \" and No Cents\" 39. Case \"One\" 40. Cents = \" and One Cent\" 41. Case Else 42. Cents = \" and \" & Cents & \" Cents\" 43. End Select 44. SpellNumber = Dollars & Cents 45. End Function 46.\'******************************************* 47.\' Converts a number from 100-999 into text * 48.\'******************************************* 49.Function GetHundreds(ByValMyNumber) 50. Dim Result As String 51. If Val(MyNumber) = 0 Then Exit Function 52. MyNumber = Right(\"000\" &MyNumber, 3) \'Convert the hundreds place 53. If Mid(MyNumber, 1, 1) \"0\" Then 54. Result = GetDigit(Mid(MyNumber, 1, 1)) & \" Hundred \" 55. End If 56. \'Convert the tens and ones place 57. If Mid(MyNumber, 2, 1) \"0\" Then 58. Result = Result &GetTens(Mid(MyNumber, 2)) 59. Else 60. Result = Result &GetDigit(Mid(MyNumber, 3)) 61. End If 62. GetHundreds = Result 63. End Function 64.\'********************************************* 65.\' Converts a number from 10 to 99 into text.* 66.\'********************************************* 67.Function GetTens(TensText) 68. Dim Result As String 69. Result = \"\" \'null out the temporary function value 70. If Val(Left(TensText, 1)) = 1 Then \' If value between 10-19 71. Select Case Val(TensText) 72. Case 10: Result = \"Ten\" 73. Case 11: Result = \"Eleven\" 74. Case 12: Result = \"Twelve\" 75. Case 13: Result = \"Thirteen\" 76. Case 14: Result = \"Fourteen\" 77. Case 15: Result = \"Fifteen\" 78. Case 16: Result = \"Sixteen\" 79. Case 17: Result = \"Seventeen\" 80. Case 18: Result = \"Eighteen\" 81. Case 19: Result = \"Nineteen\" 82. Case Else 83. End Select 84. Else \' If value between 20-99 85. Select Case Val(Left(TensText, 1)) 86. Case 2: Result = \"Twenty \" 87. Case 3: Result = \"Thirty \" 88. Case 4: Result = \"Forty \" 89. Case 5: Result = \"Fifty \" 90. Case 6: Result = \"Sixty \" 91. Case 7: Result = \"Seventy \" 92. Case 8: Result = \"Eighty \" 93. Case 9: Result = \"Ninety \" 94. Case Else 95. End Select 96. Result = Result &GetDigit _ 97. (Right(TensText, 1)) \'Retrieve ones place 98. End If 99. GetTens = Result 100. End Function 101.\'******************************************* 102.\' Converts a number from 1 to 9 into text.* 103.\'******************************************* 104.Function GetDigit(Digit) 105. Select Case Val(Digit) 106. Case 1: GetDigit = \"One\" 107. Case 2: GetDigit = \"Two\" 108. Case 3: GetDigit = \"Three\" 109. Case 4: GetDigit = \"Four\" 110. Case 5: GetDigit = \"Five\" 111. Case 6: GetDigit = \"Six\" 112. Case 7: GetDigit = \"Seven\" 113. Case 8: GetDigit = \"Eight\" 114. Case 9: GetDigit = \"Nine\" 115. Case Else: GetDigit = \"\" 116. End Select 117.End Function 复制代码
然后在A1单元格输入需要的数值，在其他单元格输入=SpellNumber (A1)即可
