Hàm SpellNumber của Microsoft

Chia sẻ bởi:hands

★★★★★

‹ Import chuỗi JSON vào Excel Import dữ liệu ›

Quảng cáo

Hơn chục năm trước mình cũng mày mò viết hàm chuyển số thành chữ, dùng cũng tàm tạm. Nay cần dùng đến tìm không ra. search trên Net thấy cái hàm này của Microsoft
support.microsoft.com/en-us/office/convert-numbers-into-words-a0d166fb-e1ea-4090-95c8-69442cd55d98

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

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

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

Cái này nó chuyển sang Dollar bằng tiếng Anh. Viết thêm phần dịch sang tiếng Việt là ổn.
Sửa đoạn đầu thành
Function SpellNumber(ByVal MyNumber, MyCurrency$)
'Main Function
If Not IsNumeric(MyNumber) Then
SpellNumber = MyNumber
Exit Function
End If
Dim NoMoneys$, OneMoney$, Moneys$, Xu$, Xus$
Select Case MyCurrency
Case "VND"
NoMoneys = "No VND"
OneMoney = "One VND"
Moneys = " VNDs"
Xu = "Cent"
Xus = "Cents"
Case "USD"
NoMoneys = "No Dollars"
OneMoney = "One Dollar"
Moneys = " Dollars"
Xu = "Cent"
Xus = "Cents"
Case "EUR"
NoMoneys = "No Euros"
OneMoney = "One Euro"
Moneys = " Euros"
Xu = "Cent"
Xus = "Cents"
End Select
…
là dùng được cả cho VND và Euro.
Cuối cùng là dịch sang tiếng Việt nữa là xong

Public Function ChangeMoney$(s$, NS$)
If s = vbNullString Then Exit Function
Dim Str$, i&, Index&
Select Case NS
Case "North": Index = 2
Case "South": Index = 3
Case Else: Index = 1
End Select
Str = s
With ShME
For i = 1 To 63
Str = Replace(Str, .Cells(i, 1), .Cells(i, Index), 1, -1, vbTextCompare)
Next
End With
If Str <> vbNullString Then
ChangeMoney$ = UCase(Left(Str, 1)) & Right(Str, Len(Str) – 1)
End If
End Function