Excel - Chuyển số thành chữ

Đây là bài viết Excel - Chuyển số thành chữ trong box Office, một box của chuyên mục Thủ Thuật; Công thức chuyển số thành chữ trong Excel Bước 1: Mở một workbook, chọn Tool >, Macro >, Visual Basic ...

kết quả từ 1 tới 10 trên 10
  1. CfowIII - 18-09-2006 03:45 PM
    Công thức chuyển số thành chữ trong Excel

    Bước 1:

    Mở một workbook, chọn Tool >, Macro >, Visual Basic Editor ->,Insert ->,Modules

    ,

    Bước 2:

    Copy và Paste toàn bộ phần code sau vào cửa sổ Modules:

    Public Function VND(BaoNhieu)

    Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String

    Dim I, J, Vitri As Byte, S As Double

    Dim Hang, Doc, Dem

    ,

    If BaoNhieu = 0 Then

    KetQua = "Khäng âäöng"

    Else

    If Abs(BaoNhieu) >,= 1E+15 Then

    KetQua = " Säú låïn quaï ???"

    Else

    If BaoNhieu <, 0 Then

    KetQua = "Træì" &, Space(1)

    Else

    KetQua = Space(0)

    End If

    ,

    SoTien = Format(Abs(BaoNhieu), "##############0.00")

    SoTien = Right(Space(15) &, SoTien, 18)

    Hang = Array("None", "tràm", "mæåi", "gç âoï")

    Doc = Array("None", "ngaìn tyí", "tyí", "triãûu", "ngaìn", "âäöng", "xu")

    Dem = Array("None", "mäüt", "hai", "ba", "bäún", "nàm", "saïu", "baíy", "taïm", "chên")

    ,

    For I = 1 To 6

    Nhom = Mid(SoTien, I * 3 - 2, 3)

    If Nhom <,>, Space(3) Then

    Select Case Nhom

    Case "000"

    If I = 5 Then

    Chu = "âäöng" &, Space(1)

    Else

    Chu = Space(0)

    End If

    ,

    Case ".00"

    Chu = "chàôn"

    Case Else

    S1 = Left(Nhom, 1)

    S2 = Mid(Nhom, 2, 1)

    S3 = Right(Nhom, 1)

    Chu = Space(0)

    Hang(3) = Doc(I)

    ,

    For J = 1 To 3

    Dich = Space(0)

    S = Val(Mid(Nhom, J, 1))

    If S >, 0 Then

    Dich = Dem(S) &, Space(1) &, Hang(J) &, Space(1)

    End If

    ,

    Select Case J

    Case 2 And S = 1

    Dich = "mæåìi" &, Space(1)

    Case 3 And S = 0 And Nhom <,>, Space(2) &, "0"

    Dich = Hang(J) &, Space(1)

    Case 3 And S = 5 And S2 <,>, Space(1) And S2 <,>, "0"

    Dich = "l" &, Mid(Dich, 2)

    Case 2 And S = 0 And S3 <,>, "0"

    If (S1 >,= "1" And S1 <,= "9") Or (S1 = "0" And I = 4) Then

    Dich = "leí" &, Space(1)

    End If

    End Select

    ,

    Chu = Chu &, Dich

    Next J

    End Select

    Vitri = InStr(1, Chu, "mæåi mäüt", 1)

    If Vitri >, 0 Then Mid(Chu, Vitri, 9) = "mæåi mäút"

    KetQua = KetQua &, Chu

    End If

    Next I

    End If

    End If

    ,

    VND = UCase(Left(KetQua, 1)) &, Mid(KetQua, 2)

    ,

    End Function

    ,

    ,

    ,

    Public Function USD(WhatNumber)

    Dim ToRead, NumString, Group, Word As String

    Dim I, J As Byte, W, X, Y, Z As Double

    Dim FristColum, SecondColum, ReadMetho

    If WhatNumber = 0 Then

    ToRead = "None"

    Else

    If Abs(WhatNumber) >,= 1E+15 Then

    ToRead = "Too long number ???"

    Else

    FristColum = Array("None", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eightteen", "nineteen")

    SecondColum = Array("None", "None", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety")

    ReadMetho = Array("None", "trillion", "billion", "million", "thousand", "dollars", "cents")

    If WhatNumber <, 0 Then

    ToRead = "Minus" &, Space(1)

    Else

    ToRead = Space(0)

    End If

    ,

    NumString = Format(Abs(WhatNumber), "##############0.00")

    NumString = Right(Space(15) &, NumString, 18)

    ,

    For I = 1 To 6

    Group = Mid(NumString, I * 3 - 2, 3)

    If Group <,>, Space(3) Then

    Select Case Group

    Case "000"

    If I = 5 And Abs(WhatNumber) >, 1 Then

    Word = "dollars" &, Space(1)

    Else

    Word = Space(0)

    End If

    ,

    Case ".00"

    Word = "only"

    Case Else

    ,

    X = Val(Left(Group, 1))

    Y = Val(Mid(Group, 2, 1))

    Z = Val(Right(Group, 1))

    W = Val(Right(Group, 2))

    If X = 0 Then

    Word = Space(0)

    Else

    ,

    Word = FristColum(X) &, Space(1) &, "hundred" &, Space(1)

    If W >, 0 And W <, 21 Then

    Word = Word &, "and" &, Space(1)

    End If

    End If

    ,

    If I = 6 And Abs(WhatNumber) >, 1 Then

    Word = "and" &, Space(1) &, Word

    End If

    If W <, 20 And W >, 0 Then

    Word = Word &, FristColum(W) &, Space(1)

    Else

    If W >,= 20 Then

    Word = Word &, SecondColum(Y) &, Space(1)

    If Z >, 0 Then

    Word = Word &, FristColum(Z) &, Space(1)

    End If

    End If

    End If

    Word = Word &, ReadMetho(I) &, Space(1)

    End Select

    ToRead = ToRead &, Word

    End If

    Next I

    End If

    End If

    ,

    USD = UCase(Left(ToRead, 1)) &, Mid(ToRead, 2)

    ,

    End Function

    ,

    ,

    ,

    Public Function VND_US(WhatNumber)

    Dim ToRead, NumString, Group, Word As String

    Dim I, J As Byte, W, X, Y, Z As Double

    Dim FristColum, SecondColum, ReadMetho

    If WhatNumber = 0 Then

    ToRead = "None"

    Else

    If Abs(WhatNumber) >,= 1E+15 Then

    ToRead = "! Too long number ???"

    Else

    FristColum = Array("None", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eightteen", "nineteen")

    SecondColum = Array("None", "None", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety")

    ReadMetho = Array("None", "trillion", "billion", "million", "thousand", "Vietnamese dong", "xu")

    If WhatNumber <, 0 Then

    ToRead = "Minus" &, Space(1)

    Else

    ToRead = Space(0)

    End If

    NumString = Format(Abs(WhatNumber), "##############0.00")

    NumString = Right(Space(15) &, NumString, 18)

    For I = 1 To 6

    Group = Mid(NumString, I * 3 - 2, 3)

    If Group <,>, Space(3) Then

    Select Case Group

    Case "000"

    If I = 5 And Abs(WhatNumber) >, 1 Then

    Word = "Vietnamese dong" &, Space(1)

    Else

    Word = Space(0)

    End If

    Case ".00"

    Word = "only"

    Case Else

    X = Val(Left(Group, 1))

    Y = Val(Mid(Group, 2, 1))

    Z = Val(Right(Group, 1))

    W = Val(Right(Group, 2))

    If X = 0 Then

    Word = Space(0)

    Else

    Word = FristColum(X) &, Space(1) &, "hundred" &, Space(1)

    If W >, 0 And W <, 21 Then

    Word = Word &, "and" &, Space(1)

    End If

    End If

    If I = 6 And Abs(WhatNumber) >, 1 Then

    Word = "and" &, Space(1) &, Word

    End If

    If W <, 20 And W >, 0 Then

    Word = Word &, FristColum(W) &, Space(1)

    Else

    If W >,= 20 Then

    Word = Word &, SecondColum(Y) &, Space(1)

    If Z >, 0 Then

    Word = Word &, FristColum(Z) &, Space(1)

    End If

    End If

    End If

    Word = Word &, ReadMetho(I) &, Space(1)

    End Select

    ToRead = ToRead &, Word

    End If

    Next I

    End If

    End If

    VND_US = UCase(Left(ToRead, 1)) &, Mid(ToRead, 2)

    End Function

    ,

    Lưu Ý :

    - Tại ô A1 bạn có số 12345 cần chuyển thành chữ tại A2, hãy gõ vào A2 công thức =vnd(A1)

    - Để hiển thị tiếng việt bạn dùng Font : VNtimes new roman

    =vnd(): Trả về VND tiếng việt

    =usd(): Trả về USD tiếng anh

    =vnd_us(): Trả về VND tiếng anh

    Chúc bạn thành công!

    =============
    Nguồn :
    http://www.dost-dongnai.gov.vn/tvtraloi.asp?idd=20050909-101029

    Các bài viết liên quan tới Excel - Chuyển số thành chữ:

  2. ==><== - 22-09-2006 06:20 PM
    Trên PCWorld VN một thời đã có tranh cãi về vấn đề này, chưa tìm được giải pháp hoàn chỉnh đúng cho mọi trường hợp. Để xem lại cái đoạn code này thế nào nào.

  3. ut_etet - 23-09-2006 11:07 AM
    Mình copy and Paste vào và thấy sai be bét. Người Post đoạn mã này đã không check kĩ trước khi Post lên.

    @embe_2006: Sau này bạn Post mã nguồn thì nên check kĩ đã nhé. Post lên sai như vậy thì có ích gì đâu.

  4. CfowIII - 23-09-2006 04:28 PM
    Nguyên văn bởi ut_etet Xem Bài viết
    Mình copy and Paste vào và thấy sai be bét. Người Post đoạn mã này đã không check kĩ trước khi Post lên.

    @embe_2006: Sau này bạn Post mã nguồn thì nên check kĩ đã nhé. Post lên sai như vậy thì có ích gì đâu.
    Sorry vì đã chưa test do hôm đó ko cài excel nhưng bro thử làm tương tự với đoạn mã này dưới đây sẽ được thôi, vì lần này test rồi :

    Function Bangchu(so)
    Dim KQ, viet, dai, tung, i
    'Laøm troøn, bieán thaønh chuoãi ñeå ñöa vaøo bieán viet
    viet = Str(Round(so, 0))
    'ñoä daøi cuûa chuoãi ñaê bieán thaønh...
    dai = Len(viet)
    'Ñaùnh vaàn töøng con soá moät theo chieàu daøi cuûa chuoãi "soá"...
    For i = 1 To dai - 1
    tung = doc(Right(Left(viet, dai - i + 1), 1), i)
    KQ = tung + " " + KQ
    'Theâm tieâu ñeà haøng ngaøn trieäu tyû ñoái vôùi töøng nhoùm 3 con soá
    Select Case i
    Case 3
    If (i + 1) < dai Then
    KQ = "ngaøn " + KQ
    End If
    Case 6
    If (i + 1) < dai Then
    KQ = "trieäu " + KQ
    End If
    Case 9
    If (i + 1) < dai Then
    KQ = "tyû " + KQ
    End If
    Case 12
    If (i + 1) < dai Then
    KQ = "nghìn tæ " + KQ
    End If
    End Select
    Next
    ' Ñaët traïng thaùi neáu coù loãi thì boû qua.
    On Error Resume Next
    'Tieán haønh thay theá caùc cuïm töø ngang ngang thaønh töø ngöõ giao tieáp 'thoâng thöôøng. Thoâng qua haøm Replace.
    If Left(Trim(KQ), 3) = "moát" Then
    KQ = "Moät" + Mid(LTrim(KQ), 4, Len(KQ) - 4)
    End If
    KQ = KQ + " ñoàng chaün"
    KQ = Replace(KQ, " ", " ")
    KQ = Replace(KQ, "möôi möôi", "möôi")
    KQ = Replace(KQ, "möôøi möôi", "möôøi")
    KQ = Replace(KQ, "möôøi moát", "möôøi moät")
    KQ = Replace(KQ, " linh möôi", "")
    KQ = Replace(KQ, " linh ñoàng", "ñoàng")
    KQ = Replace(KQ, " khoâng traêm tyû", "")
    KQ = Replace(KQ, " khoâng traêm trieäu", "")
    KQ = Replace(KQ, " khoâng traêm ngaøn", "")
    KQ = Replace(KQ, " khoâng traêm ñoàng", " ñoàng")
    KQ = Replace(KQ, " traêm moát", " traêm moät")
    Bangchu = UCase(Left(KQ, 1)) + Mid(KQ, 2, Len(KQ) - 1)
    End Function
    'Haøm doc ñeå ñaùnh vaàn töøng con soá 1
    Function doc(s, i)
    Dim KQ
    Select Case s
    Case "0"
    If (i Mod 3) = 1 Then
    KQ = "möôi"
    ElseIf (i Mod 3) = 2 Then
    KQ = "linh"
    Else
    KQ = "khoâng"
    End If
    Case "1"
    If (i Mod 3) = 1 Then
    KQ = "moát"
    ElseIf (i Mod 3) = 2 Then
    KQ = "möôøi"
    Else
    KQ = "moät"
    End If
    Case "2"
    KQ = "hai"
    Case "3"
    KQ = "ba"
    Case "4"
    KQ = "boán"
    Case "5"
    KQ = "naêm"
    Case "6"
    KQ = "saùu"
    Case "7"
    KQ = "baûy"
    Case "8"
    KQ = "taùm"
    Case "9"
    KQ = "chín"
    End Select
    If ((i Mod 3) = 0) And (KQ <> "linh") Then
    KQ = KQ + " traêm"
    ElseIf (i Mod 3) = 2 And (KQ <> "möôi") Then
    KQ = KQ + " möôi"
    End If
    doc = KQ
    End Function

    testedxt6

    Dùng font Vni để hiển thị kết quả.

    Bài viết sưu tầm từ Echip

  5. needfull - 26-09-2006 04:16 PM
    Nguyên văn bởi embe_2006 Xem Bài viết
    Công thức chuyển số thành chữ trong Excel

    Bước 1:

    .......

    - Để hiển thị tiếng việt bạn dùng Font : VNtimes new roman

    =vnd(): Trả về VND tiếng việt

    =usd(): Trả về USD tiếng anh

    =vnd_us(): Trả về VND tiếng anh

    Chúc bạn thành công!
    Thực ra c.trình bạn sưu tầm rất được, chỉ mất công chỉnh tí là OK

    sorachudw9

    Public Function VND(BaoNhieu)

    Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String

    Dim i, J, Vitri As Byte, s As Double

    Dim Hang, doc, Dem

    If BaoNhieu = 0 Then

    KetQua = "Khäng âäöng"

    Else

    If Abs(BaoNhieu) >= 1E+15 Then

    KetQua = " Säú låïn quaï ???"

    Else

    If BaoNhieu < 0 Then

    KetQua = "Træì" & Space(1)

    Else

    KetQua = Space(0)

    End If


    SoTien = Format(Abs(BaoNhieu), "##############0.00")

    SoTien = Right(Space(15) & SoTien, 18)

    Hang = Array("None", "tràm", "mæåi", "gç âoï")

    doc = Array("None", "ngaìn tyí", "tyí", "triãûu", "ngaìn", "âäöng", "xu")

    Dem = Array("None", "mäüt", "hai", "ba", "bäún", "nàm", "saïu", "baíy", "taïm", "chên")


    For i = 1 To 6

    Nhom = Mid(SoTien, i * 3 - 2, 3)

    If Nhom <> Space(3) Then

    Select Case Nhom

    Case "000"

    If i = 5 Then

    Chu = "âäöng" & Space(1)

    Else

    Chu = Space(0)

    End If

    Case ".00"

    Chu = "chàôn"

    Case Else

    S1 = Left(Nhom, 1)

    S2 = Mid(Nhom, 2, 1)

    S3 = Right(Nhom, 1)

    Chu = Space(0)

    Hang(3) = doc(i)


    For J = 1 To 3

    Dich = Space(0)

    s = Val(Mid(Nhom, J, 1))

    If s > 0 Then

    Dich = Dem(s) & Space(1) & Hang(J) & Space(1)

    End If

    Select Case J

    Case 2 And s = 1

    Dich = "mæåìi" & Space(1)

    Case 3 And s = 0 And Nhom <> Space(2) & "0"

    Dich = Hang(J) & Space(1)

    Case 3 And s = 5 And S2 <> Space(1) And S2 <> "0"

    Dich = "l" & Mid(Dich, 2)

    Case 2 And s = 0 And S3 <> "0"

    If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And i = 4) Then

    Dich = "leí" & Space(1)

    End If

    End Select


    Chu = Chu & Dich

    Next J

    End Select

    Vitri = InStr(1, Chu, "mæåi mäüt", 1)

    If Vitri > 0 Then Mid(Chu, Vitri, 9) = "mæåi mäút"

    KetQua = KetQua & Chu

    End If

    Next i

    End If

    End If

    VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)

    End Function


    Public Function USD(WhatNumber)

    Dim ToRead, NumString, Group, Word As String

    Dim i, J As Byte, W, X, Y, Z As Double

    Dim FristColum, SecondColum, ReadMetho

    If WhatNumber = 0 Then

    ToRead = "None"

    Else

    If Abs(WhatNumber) >= 1E+15 Then

    ToRead = "Too long number ???"

    Else

    FristColum = Array("None", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eightteen", "nineteen")

    SecondColum = Array("None", "None", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety")

    ReadMetho = Array("None", "trillion", "billion", "million", "thousand", "dollars", "cents")

    If WhatNumber < 0 Then

    ToRead = "Minus" & Space(1)

    Else

    ToRead = Space(0)

    End If


    NumString = Format(Abs(WhatNumber), "##############0.00")

    NumString = Right(Space(15) & NumString, 18)


    For i = 1 To 6

    Group = Mid(NumString, i * 3 - 2, 3)

    If Group <> Space(3) Then

    Select Case Group

    Case "000"

    If i = 5 And Abs(WhatNumber) > 1 Then

    Word = "dollars" & Space(1)

    Else

    Word = Space(0)

    End If


    Case ".00"

    Word = "only"

    Case Else


    X = Val(Left(Group, 1))

    Y = Val(Mid(Group, 2, 1))

    Z = Val(Right(Group, 1))

    W = Val(Right(Group, 2))

    If X = 0 Then

    Word = Space(0)

    Else


    Word = FristColum(X) & Space(1) & "hundred" & Space(1)

    If W > 0 And W < 21 Then

    Word = Word & "and" & Space(1)

    End If

    End If


    If i = 6 And Abs(WhatNumber) > 1 Then

    Word = "and" & Space(1) & Word

    End If

    If W < 20 And W > 0 Then

    Word = Word & FristColum(W) & Space(1)

    Else

    If W >= 20 Then

    Word = Word & SecondColum(Y) & Space(1)

    If Z > 0 Then

    Word = Word & FristColum(Z) & Space(1)

    End If

    End If

    End If

    Word = Word & ReadMetho(i) & Space(1)

    End Select

    ToRead = ToRead & Word

    End If

    Next i

    End If

    End If


    USD = UCase(Left(ToRead, 1)) & Mid(ToRead, 2)

    End Function



    Public Function VND_US(WhatNumber)

    Dim ToRead, NumString, Group, Word As String

    Dim i, J As Byte, W, X, Y, Z As Double

    Dim FristColum, SecondColum, ReadMetho

    If WhatNumber = 0 Then

    ToRead = "None"

    Else

    If Abs(WhatNumber) >= 1E+15 Then

    ToRead = "! Too long number ???"

    Else

    FristColum = Array("None", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eightteen", "nineteen")

    SecondColum = Array("None", "None", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety")

    ReadMetho = Array("None", "trillion", "billion", "million", "thousand", "Vietnamese dong", "xu")

    If WhatNumber < 0 Then

    ToRead = "Minus" & Space(1)

    Else

    ToRead = Space(0)

    End If

    NumString = Format(Abs(WhatNumber), "##############0.00")

    NumString = Right(Space(15) & NumString, 18)

    For i = 1 To 6

    Group = Mid(NumString, i * 3 - 2, 3)

    If Group <> Space(3) Then

    Select Case Group

    Case "000"

    If i = 5 And Abs(WhatNumber) > 1 Then

    Word = "Vietnamese dong" & Space(1)

    Else

    Word = Space(0)

    End If

    Case ".00"

    Word = "only"

    Case Else

    X = Val(Left(Group, 1))

    Y = Val(Mid(Group, 2, 1))

    Z = Val(Right(Group, 1))

    W = Val(Right(Group, 2))

    If X = 0 Then

    Word = Space(0)

    Else

    Word = FristColum(X) & Space(1) & "hundred" & Space(1)

    If W > 0 And W < 21 Then

    Word = Word & "and" & Space(1)

    End If

    End If

    If i = 6 And Abs(WhatNumber) > 1 Then

    Word = "and" & Space(1) & Word

    End If

    If W < 20 And W > 0 Then

    Word = Word & FristColum(W) & Space(1)

    Else

    If W >= 20 Then

    Word = Word & SecondColum(Y) & Space(1)

    If Z > 0 Then

    Word = Word & FristColum(Z) & Space(1)

    End If

    End If

    End If

    Word = Word & ReadMetho(i) & Space(1)

    End Select

    ToRead = ToRead & Word

    End If

    Next i

    End If

    End If

    VND_US = UCase(Left(ToRead, 1)) & Mid(ToRead, 2)

    End Function
    Bạn copy lại module trên thay cho cái trước là được (Xem hình trên)

  6. ntcong - 19-02-2008 10:26 AM
    Khi chuyển sang font VNI thì hiển thị ra chowx tiếng Việt nhưng bị lỗi. Needful chỉnh sửa lại code để có thể dùng được font unicode nhé. Thanks.

  7. luongvandoc - 26-04-2010 03:20 PM
    cac bac oi giup toi voi , toi da keo ve roi nhung fon chu van k dung duoc , huong dan cach lam cho toi voi

  8. luongvandoc - 29-04-2010 11:34 AM
    Cach sửa lại code để có thể dùng được font unicode nhu the nao giup toi voi.

  9. huken83 - 02-05-2010 02:33 PM
    thủ thuật rất bổ ích để có kĩ năng thành thạo cần phải luyện nhiều
    thanks bác nhé

  10. huyle1989 - 18-01-2011 09:41 AM
    mình thì hay xài tiện ich tiếng việt
    http://www.mediafire.com/?zjmwogtzgot
    cái này xài rất ổn
    tác giả Phạm Kim Trung
    có vài tiện ích khác nữa cũng rất hay dùng đối với dân văn phòng.