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

Description: 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. 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

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.
 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

Mới hơn
Cũ hơn
Cũ hơn
Next Post

Ý kiến bạn đọc:

Với các bài đăng lại, tác giả sẽ sớm cập nhập nguồn hoặc xóa bỏ nếu nhận được yêu cầu từ chính tác giả!- trân trọng cám ơn!

Xem nhiều cùng chủ đề: