Code đọc số thành chữ trong excel mới nhất

Code đọc số  thành chữ trong excel mới nhất . Code thường thì ở dạng Macro kiểu (Sub gì đó()… End Sub) thì sẽ được lưu trong Module.
Code đọc số  thành chữ trong excel mới nhất
Code đọc số thành chữ trong excel mới nhất

Code đọc số thành chữ trong excel

 Bạn làm như sau: Nhấn Alt + F11 -> Nhấn phải chuột lên các tên sheet -> Chọn Insert Module -> Rồi Paste vào trong Module đó.

Để chạy thì có thể nhấn vào lệnh Run (Hình mũi tên xanh phía trên) hoặc vào lại trang bảng tính Excel nhấn Alt + F8 -> Chọn tên sub vừa rồi -> Run.

Còn 1 số code khác có định dạng kiểu (Function gì đó(…) … End Function) thì cũng nằm trong Module nhưng không chạy được bằng lệnh Run mà phải chạy chúng kiểu như dùng các hàm IF, SUM hay SUMPRODUCT vậy.

 Còn 1 dạng code cuối cùng là các code thường được bắt đầu bằng Private Sub Worksheet hoặc Private Sub Workbook thì đặt chúng trong các tên Sheet ở VBA hoặc nằm trong ThisWorkbook luôn.

 

Private Function Doc(so As String) As String
Dim j As Integer, i As Integer
Dim s1 As String, s2 As String
    s1 = "10" + so
    j = Len(so)
    s2 = ""
    For i = 3 To j + 2
        Select Case Mid(s1, i, 1)
            Case "0":
                Select Case (j - i + 2) Mod 3
                    Case 0: If j = 1 Then s2 = " kh" + ChrW(244) + "ng"
                    Case 1:
                        If Mid(s1, i + 1, 1) <> "0" Then s2 = s2 + " l" + ChrW(7867)
                    Case 2:
                        If Mid(s1, i + 1, 2) <> "00" Then s2 = s2 + " kh" + ChrW(244) + "ng"
                End Select
            Case "1":
                Select Case (j - i + 2) Mod 3
                    Case 0:
                        c = Mid(s1, i - 1, 1)
                        If c <> "0" And c <> "1" Then
                            s2 = s2 + " m" + ChrW(7889) + "t"
                        Else: s2 = s2 + " m" + ChrW(7897) + "t"
                        End If
                    Case 1: s2 = s2 + " m" + ChrW(432) + ChrW(7901) + "i"
                    Case 2: s2 = s2 + " m" + ChrW(7897) + "t"
                End Select
            Case "2": s2 = s2 + " hai"
            Case "3": s2 = s2 + " ba"
            Case "4": s2 = s2 + " b" + ChrW(7889) + "n"
            Case "5":
                If ((j - i + 2) Mod 3 = 0 And Mid(s1, i - 1, 1) <> "0") Then
                    s2 = s2 + " l" + ChrW(259) + "m"
                Else: s2 = s2 + " n" + ChrW(259) + "m"
                End If
            Case "6": s2 = s2 + " s" + ChrW(225) + "u"
            Case "7": s2 = s2 + " b" + ChrW(7843) + "y"
            Case "8": s2 = s2 + " t" + ChrW(225) + "m"
            Case "9": s2 = s2 + " ch" + ChrW(237) + "n"
        End Select
        Select Case (j - i + 2)
            Case 1, 4, 7, 10, 13:
                c = Mid(s1, i, 1)
                If c <> "1" And c <> "0" Then s2 = s2 + " m" + ChrW(432) + ChrW(417) + "i"
            Case 2, 5, 8, 11, 14:
                If Mid(s1, i, 1) <> "0" Or Mid(s1, i + 1, 2) <> "00" Then s2 = s2 + " tr" + ChrW(259) + "m"
            Case 3, 12: If Mid(s1, i - 2, 3) <> "000" Then s2 = s2 + " ng" + ChrW(224) + "n"
            Case 6: If Mid(s1, i - 2, 2) <> "00" Then s2 = s2 + " tri" + ChrW(7879) + "u"
            Case 9: s2 = s2 + " t" + ChrW(7881)
        End Select
    Next
    Doc = Trim(s2)
    'Doc = UCase(Mid(s2, 1, 1)) + Mid(s2, 2, Len(s2) - 1)
End Function
Private Function DocRoi(so As String) As String
Dim i As Integer
Dim c As String * 1
Dim s As String
    s = ""
    For i = 1 To Len(so)
        c = Mid(so, i, 1)
        Select Case c
            Case "0": s = s + "kh" + ChrW(244) + "ng "
            Case "1": s = s + "m" + ChrW(7897) + "t "
            Case "2": s = s + "hai "
            Case "3": s = s + "ba "
            Case "4": s = s + "b" + ChrW(7889) + "n "
            Case "5": s = s + "n" + ChrW(259) + "m "
            Case "6": s = s + "s" + ChrW(225) + "u "
            Case "7": s = s + "b" + ChrW(7843) + "y "
            Case "8": s = s + "t" + ChrW(225) + "m "
            Case "9": s = s + "ch" + ChrW(237) + "n "
            Case ".", ",": s = s + "ph" + ChrW(7849) + "y "
        End Select
        DocRoi = Trim(s)
    Next
End Function
Public Function SoTien(so As String, Optional donvi As String = 0) As String
    Select Case donvi
        Case 0: donvi = ""
        Case 1: donvi = " " + ChrW(273) + ChrW(7891) + "ng"
        Case 2: donvi = " " + ChrW(273) + ChrW(7891) + "ng ch" + ChrW(7861) + "n"
        Case 3: donvi = " VND"
        Case 4: donvi = " USD"
        Case 5: donvi = " GBP"
    End Select
    so = Trim(Str(Round(Val(so), 0)))
    SoTien = Doc(so) + " " + Trim(donvi)
    SoTien = UCase(Mid(SoTien, 1, 1)) + Mid(SoTien, 2, Len(SoTien) - 1)
End Function
Private Function XuLy(so As String) As String
Dim j As Byte, i As Byte
Dim c As String * 1
Dim d As Boolean
Dim s1 As String
    d = False
    For j = 1 To Len(so)
        If Mid(so, j, 1) < "0" Or Mid(so, j, 1) > "9" Then
            d = True
            c = Mid(so, j, 1)
            i = j
        End If
    Next
    s1 = ""
    For j = 1 To Len(so)
        If Mid(so, j, 1) >= "0" And Mid(so, j, 1) <= "9" Then s1 = s1 + Mid(so, j, 1)
        If j = i Then s1 = s1 + ","
    Next
    XuLy = s1
End Function
Public Function DocSo(so As String, Optional k As Byte = 0) As String
Dim s1 As String, s2 As String
Dim i As Integer
    'so = Trim(Str(Val(so)))
    so = XuLy(so)
    i = 1
    Do
        s1 = s1 + Mid(so, i, 1)
        i = i + 1
    Loop Until i = Len(so) + 1 Or Mid(so, i, 1) < "0" Or Mid(so, i, 1) > "9"
    For j = i + 1 To Len(so)
            If Mid(so, j, 1) >= "0" And Mid(so, j, 1) <= "9" Then s2 = s2 + Mid(so, j, 1)
    Next j
    If s1 = "" Then Exit Function
    If k = 0 Then
        DocSo = Doc(s1)
    Else: DocSo = DocRoi(s1)
    End If
    If s2 <> "" Then
        If k = 0 Then
            DocSo = DocSo + " ph" + ChrW(7849) + "y " + Doc(s2)
        Else: DocSo = DocSo + " ph" + ChrW(7849) + "y " + DocRoi(s2)
        End If
        'For i = 1 To Len(s2)
        '    DocSo = DocSo + " " + Doc(Mid(s2, i, 1))
        'Next i
    End If
    If Len(DocSo) > 1 Then
        DocSo = UCase(Mid(DocSo, 1, 1)) + Mid(DocSo, 2, Len(DocSo) - 1)
    End If
End Function

Có 3 cách chuyển số thành chữ trong hàm VBA
Đổi số thành chữ là một công việc gần như gặp hằng ngày với các bạn làm ủy nhiệm chi ngân hàng, viết hóa đơn, thu chi tiền mặt, phiếu lương…Nếu làm thủ công thì sẽ rất mất thời gian và dễ sai sót. Dân Tài Chính sẽ hướng dẫn bạn 3 cách để chuyển số sang chữ trong excel cực kì đơn giản, nhanh và chính xác:

Cách 1: Sử dụng hàm trực tiếp, không dùng VBA hay Add-ins.
[​IMG]

Đầu tiên bạn tải file có công thức sẵn này về: doi-so-thanh-chu.xlsx (size: 95kb) – google driver
Sau đó bạn nhập số cần đọc vào ô B2 như hình bên trên là xong. Bạn có thể copy nguyên phần công thức đó vào bảng tính hiện tại của bạn sau đó link phần chữ qua là được.

Cách 2: Sử dụng VBA để chuyển số thành chữ
Bạn không phải là người rành về VBA nên nghe có vẻ sợ nhưng đừng lo, sẽ rất đơn giản. Bạn chỉ cần 4 bước sau để thêm đoạn mã VBA đổi số thành chữ vào bảng tính của bạn:
Bước 1: Mở bảng tính mà bạn cần đánh vần các con số.

Bước 2: Nhấn Alt + F11 để mở cửa sổ trình soạn thảo Visual Basic.
Bước 3: Nếu bạn đang mở nhiều tệp tin, hãy chọn bảng tính cần thiết bằng cách sử dụng danh sách các tệp ở bên trái của trình soạn thảo (tệp sẽ được đánh dấu màu xanh).
Bước 4: Trong trình đơn chỉnh sửa hãy vào Insert-> Module .
[​IMG]
Bước 5: Bạn sẽ thấy cửa sổ có tên YourBook – Module1. Chọn tất cả mã trong khung bên dưới và dán nó vào cửa sổ này.
[​IMG]

Nếu bị lỗi font thì các bạn tải file này về nhé, code đã có sẵn trong file: doisothanhchu.xlsm (size: 25kb)

Bước 6: Bạn quay lại bảng tính vàsử dụng hàm VND để đọc số. Nhập =VND(B2) vào ô nơi bạn cần lấy số được viết bằng từ. Ở đây B2 là địa chỉ của ô có số hoặc số.

[​IMG]

Lưu ý khi lưu bảng tính có VBA bạn phải lưu với định dạng .xlsm thì mới lưu được nhé.

Cách 3: Sử dụng Add-ins AccHelper để đọc số
Accounting Helper là một Add-ins đọc số đa năng vô cùng mạnh mẽ dành cho Excel:
– Cung cấp các hàm đọc số thành chữ bằng tiếng Anh, Việt bởi các loại font chữ TCVN3 (ABC), VNI, UNICODE. Các hàm: VND(), USD(), Num2Str().
– Cung cấp hàm chuyển đổi font chữ từ TCVN3, VNI sang UNICODE. Hàm ToUNC().

Function UnicodeChar(UniCharCode As String) As String
On Error GoTo Loi
Dim str
Dim desStr As String
Dim I
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
str = UniCharCode
str = Split(str, ";")
For I = LBound(str) To UBound(str)
desStr = desStr & ChrW$("&H" & str(I))
Next
UnicodeChar = desStr
Loi:
Exit Function
End Function

Function vnd(ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, I As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
NumCurrency = Round(NumCurrency, 0)
DonViTien = ";111;1ED3;6E;67" ' d?ng
DonViLe = ";78;75" ' xu
If NumCurrency = 0 Then
vnd = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If NumCurrency > 922337203685477# Then ' S? l?n nh?t c?a lo?i CURRENCY
vnd = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' m?t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' b?n
CharVND(5) = ";6E;103;6D" ' nam
CharVND(6) = ";73;E1;75" ' s?u
CharVND(7) = ";62;1EA3;79" ' b?y
CharVND(8) = ";74;E1;6D" ' t?m
CharVND(9) = ";63;68;ED;6E" ' ch?n
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 k? s?
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
I = 5
Else
BangChu = ""
I = 0
End If
'-----------------------------------------------------
' B?t d?u d?i
'-----------------------------------------------------
While I <= 5 Select Case I Case 0 SoDoi = NganTy Ten = ";6E;67;E0;6E;20;74;1EF7" ' ng?n t? Case 1 SoDoi = Ty Ten = ";74;1EF7" ' t? Case 2 SoDoi = Trieu Ten = ";74;72;69;1EC7;75" ' tri?u Case 3 SoDoi = Ngan Ten = ";6E;67;E0;6E" ' ng?n Case 4 SoDoi = Dong Ten = DonViTien ' d?ng Case 5 SoDoi = SoLe Ten = DonViLe ' xu End Select If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _
IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
BangChu = BangChu + ";6C;1EBB;20"
Else
If Muoi <> 0 Then
BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
End If
End If
If Muoi <> 0 And DonVi = 5 Then
BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
Else
If Muoi > 1 And DonVi = 1 Then
BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
Else
BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
End If
End If
Else
BangChu = BangChu + IIf(I = 4, DonViTien + "", "")
End If
I = I + 1
Wend
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20") + ";63;68;1EB5;6E"
End If
BangChu = UnicodeChar(BangChu)
'??i sang ti?ng Vi?t Unicode
' ??i ch? c?i d?u ti?n th?nh ch? hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
vnd = BangChu
End Function 

Bạn tải Add-ins về tại đây (size: 95kb), tiến hành giải nén và làm theo hướng dẫn trong file huongdan.txt nhé.

Vậy là bạn đã có 3 cách chuyển số thành chữ trên Excel 365 rồi nhé, bạn cũng có thể áp dụng tương tự trên Excel 2003, 2007, 2013, 2016, 2019, 2010, 2013 đều được. Nếu bạn gặp khó khăn trong lúc thực hiện có thể để lại lời nhắn bên dưới mình sẽ hỗ trợ.

Code bổ sung:

Function DocSoVni(conso) As String
s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
lop3 = Array("", " trieäu", " nghìn", " tyû")
If Trim(conso) = "" Then
DocSoVni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = "aâm " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tyû" Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
Else
s1 = s09(n1) & " traêm"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " möôøi" Else s2 = s09(n2) & " möôi"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " laêm"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
Else
DocSoVni = conso
End If
End Function
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
End Function 

Code VBA đổi số thành chữ trong Excel,
Hàm đổi số thành chữ trong Excel 2016,
Hàm đổi số thành chữ trong Excel,
Công thức đổi số thành chữ,
Phần mềm đọc số thành chữ,
Chuyển số thành chữ trong Excel không dụng phần mềm,
Chuyển số thành chữ trong Excel macbook,
Code đọc số thành chữ

Có thể bạn quan tâm:

Giới thiệu Blog

Cuộc sống - cho đi là còn mãi- chia sẻ và yêu thương!

Chào các bạn- Mình là Ngô Hải Long - Ceo công ty Giải pháp số LBK- Chuyên seo web, quảng cáo Google , Facebook, Zalo và lập trình web wordpress, App (ứng dụng) IOS, Android. Các blog lập ra với mục đích chia sẻ kiến thức cuộc sống, thủ thuật máy tính, việc làm, tài liệu miễn phí. Trong quá trình đội ngũ biên soạn không tránh khỏi thiếu sót hoặc trùng lặp nội dung với các quý blog khác, thành thật xin lỗi nếu có sự cố đó xảy ra - Vậy bạn Vui lòng liên hệ giúp tới ngolonglbk@gmail.com nếu có bất cứ ý kiến, thắc mắc , yêu cầu xóa bài nào! Trân trọng cám ơn các bạn!

Chào mừng các bạn đến với  ngolongnd.net - Blog thư giãn và chia sẻ kiến thức, tài liệu miễn phí! 

Liên hệ quảng cáo- mua back link tại đây

(function($) { $(document).ready(function() { $('header .ux-search-submit').click(function() { console.log('Moew'); $('header form.search_google').submit(); }); }); })(jQuery);