Hiển thị kết quả từ 1 đến 2 / 2
  1. #1
    Tham gia
    13-08-2012
    Location
    Vĩnh Cửu, Đồng Nai
    Bài viết
    78
    Like
    7
    Thanked 9 Times in 8 Posts

    Code đổi số sang chữ (Sưu tầm)

    Code:
    'Nguồn: http://tuygialai.blogspot.com/2014/0...ong-excel.html
    
    
    Attribute VB_Name = "Module1"
    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ách sử dụng: Hàm trên là ngôn ngữ VBA sử dụng trong Excel.
    Vào Excel. ALt-F11 (Visual Basic for App..), Chọn Insert Modul..Dán đoạn lệnh trên vào.. Save..
    Trong Excel, Tại ô A1 có chứa số, ví dụ 123456, thì tại ô A2 gõ =Sotien(A1).
    Kết quả sẽ là "Một trăm hai mươi ba ngàn bốn trăm năm mươi sáu".
    Được sửa bởi ada95 lúc 13:09 ngày 30-11-2017
    Unus Pro Omnibus, Omnes Pro Uno
    Quote Quote

  2. Thành viên Like bài viết này:


  3. #2
    Tham gia
    21-11-2019
    Location
    TPHCM
    Bài viết
    13
    Like
    11
    Thanked 0 Times in 0 Posts
    Bạn có code chuyển chữ có dấu thành không có dấu không? ví dụ: "TIN HỌC" chuyển thành "TIN HOC"
    Hiểu ý mình không? mình đang rất cần!

    - - - Updated - - -

    Bạn có code chuyển chữ có dấu thành không có dấu không? ví dụ: "TIN HỌC" chuyển thành "TIN HOC"
    Hiểu ý mình không? mình đang rất cần!

Bookmarks

Quy định

  • Bạn không thể tạo chủ đề mới
  • Bạn không thể trả lời bài viết
  • Bạn không thể gửi file đính kèm
  • Bạn không thể sửa bài viết của mình
  •