之前一個網友工作中需要把數字轉換為英文大寫，於是就給他寫了一個。函數有兩個參數，數字和單位。第二個參數為計量單位，可以是貨幣也可以是重量。 代碼如下：
1 Function Num2Str(FullNum As Variant, NumUnit As Integer) 2 Dim NumLen As Integer 3 Dim i As Integer 4 Dim ArrUnit 5 Dim SubUnit 6 Dim Factor 7 Dim Num As Variant 8 Dim Dec As String 9 10 ArrUnit = Array("Dollar", "Euro", "KG", "KPC") 11 SubUnit = Array("Cent", "Cent", "G", "PC") 12 Factor = Array(100, 100, 1000, 1000) 13 14 Num = Int(FullNum) 15 Dec = Right(Application.Round(((FullNum - Num) * Factor(NumUnit)), 0) + 1000, 3) 16 17 NumLen = Application.RoundUp(Len(Num) / 3, 0) 18 Num2Str = "" 19 20 For i = NumLen To 1 Step -1 21 Num2Str = Num2Str & NumPart(Mid(10 ^ (3 * NumLen) + Num, 2 + 3 * NumLen - 3 * i, 3), i) 22 Next i 23 24 Num2Str = Num2Str & " " & ArrUnit(NumUnit) 25 If Num > 1 Then Num2Str = Num2Str & "s" 26 If Dec <> "000" Then 27 Num2Str = Num2Str & NumPart(Dec, 1) ' 28 Num2Str = Num2Str & " " & SubUnit(NumUnit) 29 If Dec <> "001" Then Num2Str = Num2Str & "s" 30 End If 31 Num2Str = Num2Str & "." 32 33 End Function 34 35 Function NumPart(Num As String, Part As Integer) 36 Dim ArrNum 37 Dim ArrTen 38 Dim ArrTeen 39 Dim iDigit As Integer 40 41 ArrNum = Array("One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine") 42 ArrTen = Array("Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninty") 43 ArrTeen = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen") 44 45 iDigit = Left(Num, 1) 46 If iDigit <> 0 Then NumPart = " " & ArrNum(iDigit - 1) & " Hundred" 47 48 iDigit = Mid(Num, 2, 1) 49 If iDigit = 1 Then 50 iDigit = Right(Num, 1) 51 NumPart = NumPart & " " & ArrTeen(iDigit) & " " 52 GoTo Unit 53 Else 54 If iDigit <> 0 Then NumPart = NumPart & " " & ArrTen(iDigit - 2) 55 End If 56 57 iDigit = Right(Num, 1) 58 If iDigit <> 0 Then NumPart = NumPart & " " & ArrNum(iDigit - 1) 59 60 Unit: 61 If Part = 3 Then NumPart = NumPart & " Million " 62 If Part = 2 Then NumPart = NumPart & " Thousand " 63 64 End Function