Code VBA Excel đổi số thành chữ
(Không có dấu phẩy phân cách tỷ, triệu, ngàn)

Cú pháp: =DocSo(Number,Font)

  Trong đó:

• Number: là số cần đọc

• Font dùng để chọn bảng mã của chuỗi kết quả. Nếu bỏ qua tham số này thì mặc định là Unicode.

• 1 = Unicode; 

• 2 = VNI Windows; 

• 3 = TCVN3. 

Sau đây là đoạn CODE: 

'Ks. Huynh Hieu Nghia - Tp. Can Tho - 0939.035.839

Function DocSo(ByVal Number, Optional ByVal Font = 1) As String

Dim MyArray

Dim Str

Str = Format(Abs(Number), "000000000000000000")

Select Case Font

Case 1

MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u ", "ngàn ", "t" & ChrW(7927) & " " & ", ", "tri" & ChrW(7879) & "u ", "ngàn ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")

Case 2

MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu ", "ngaøn ", "tyû ", "trieäu ", "ngaøn ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")

Case 3

MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu ", "ngµn ", "tû ", "triÖu ", "ngµn ", "", "tr¨m ", "m­¬i ", "kh«ng m­¬i kh«ng ", "kh«ng m­¬i", "lÎ", "m­¬i kh«ng", "m­¬i", "m­¬i n¨m", "m­¬i l¨m", "mét m­¬i", "m­êi", "m­¬i mét", "m­¬i mèt", "¢m ")

End Select

If Str = "000000000000000000" Then

    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."

    Exit Function

End If

For i = 1 To Len(Str)

If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then

    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))

ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then

    DocSo = DocSo & MyArray(12)

End If

Next

DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))

If Number < 0 Then

DocSo = MyArray(29) & DocSo

End If

DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & " ", ", ", "") & ChrW(273) & ChrW(7891) & "ng."

End Function