Chuyển số thành chữ

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
Đăng trả lời
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 527 times

Chuyển số thành chữ

Gửi bài by truongphu »

Thủ thuật: Chuyển số thành chữ
Tác giả: truongphu
Mô tả: Chuyển số thành chữ, phân biệt "một" và "mốt", "năm" và "lăm"... code gọn

  1. Option Explicit
  2. Function BàngChu(Num As Long) '< 2147483647
  3. If Num = 0 Then   'Không hô tró tiêng Viêt tôt!
  4.    BàngChu = "Không"
  5.     Exit Function
  6. End If
  7. Dim DL(9) As String
  8. DL(1) = " môt"
  9. DL(2) = " hai"
  10. DL(3) = " ba"
  11. DL(4) = " bô'n"
  12. DL(5) = " nam"
  13. DL(6) = " sáu"
  14. DL(7) = " bay"
  15. DL(8) = " tám"
  16. DL(9) = " chín"
  17. Dim TP(1 To 4) As String, Chuôi As String, i As Byte, DuoiNgan As Integer
  18. Dim HàngÐvi As Byte, HàngChuc As Byte, HàngTram As Byte
  19. TP(2) = " ngàn"
  20. TP(3) = " triêu"
  21. TP(4) = " ty"
  22. i = 1
  23.  
  24. While i < 5   'vòng lap, có 4 vòng < ngàn, , triêu, < ty và ty
  25.  
  26. DuoiNgan = Num Mod 1000 'Lây 3 sô sau
  27. Num = Num \ 1000 'Num Ða loai 3 sô sau
  28.  
  29. HàngÐvi = DuoiNgan Mod 10
  30. HàngChuc = DuoiNgan \ 10 Mod 10
  31. HàngTram = DuoiNgan \ 100
  32.  
  33. If Len(Chuôi) <= 12 And DuoiNgan <> 0 Then
  34. Chuôi = TP(i) & Chuôi
  35. End If
  36. i = i + 1
  37.  
  38. Select Case HàngÐvi
  39. Case 1
  40. If HàngChuc > 1 Then Chuôi = " m'ôt" & Chuôi Else Chuôi = " môt" & Chuôi
  41. Case 5
  42. If HàngChuc = 0 Then Chuôi = " nam" & Chuôi Else Chuôi = " lam" & Chuôi
  43. Case Else
  44. Chuôi = DL(HàngÐvi) & Chuôi
  45. End Select
  46.  
  47. Select Case HàngChuc
  48. Case 1
  49. Chuôi = " muo`i" & Chuôi
  50. Case 0
  51. If (Num <> 0 Or HàngTram <> 0) And HàngÐvi <> 0 Then Chuôi = " le" & Chuôi
  52. Case Else
  53. Chuôi = DL(HàngChuc) & " muoi" & Chuôi
  54. End Select
  55.  
  56. Select Case HàngTram
  57. Case 0
  58. If Num <> 0 And (HàngÐvi <> 0 Or HàngChuc <> 0) Then Chuôi = " không tram" & Chuôi
  59. If Num <> 0 And i > 2 And DuoiNgan = 0 And HàngÐvi = 0 And HàngChuc = 0 And HàngTram = 0 And Len(Chuôi) <= 12 Then Chuôi = Chuôi
  60. Case Else
  61. Chuôi = DL(HàngTram) & " tram" & Chuôi
  62. End Select
  63.  
  64. Wend        'thoát vòng lap
  65. ' viêt Hoa
  66. BàngChu = UCase(Left(Trim(Chuôi), 1)) & Right(Chuôi, Len(Trim(Chuôi)) - 1)
  67.  
  68. End Function
  69.  
  70.  
  71. Private Sub Command1_Click()
  72. MsgBox BàngChu(Text1)
  73. End Sub
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
Hình đại diện của thành viên
ongdat76
Guru
Guru
Bài viết: 82
Ngày tham gia: Thứ 5 09/03/2006 10:11 am
Đến từ: Thành phố Vinh - Nghệ An
Has thanked: 1 time
Been thanked: 2 times
Tiếp xúc:

Re: Chuyển số thành chữ

Gửi bài by ongdat76 »

Còn đây là đổi số sang string bằng tiếng Anh:

Mã: Chọn tất cả

Public Function NumToString(ByVal nNumber As Currency) As String Dim bNegative As BooleanDim bHundred As Boolean If nNumber < 0 Then    bNegative = TrueEnd If nNumber = Abs(Int(nNumber)) If nNumber < 1000 Then    If nNumber \ 100 > 0 Then        NumToString = NumToString & _             NumToString(nNumber \ 100) & " hundred"        bHundred = True    End If    nNumber = nNumber - ((nNumber \ 100) * 100)    Dim bNoFirstDigit As Boolean    bNoFirstDigit = False    Select Case nNumber \ 10        Case 0            Select Case nNumber Mod 10                Case 0                    If Not bHundred Then                        NumToString = NumToString & " zero"                    End If                Case 1: NumToString = NumToString & " one"                Case 2: NumToString = NumToString & " two"                Case 3: NumToString = NumToString & " three"                Case 4: NumToString = NumToString & " four"                Case 5: NumToString = NumToString & " five"                Case 6: NumToString = NumToString & " six"                Case 7: NumToString = NumToString & " seven"                Case 8: NumToString = NumToString & " eight"                Case 9: NumToString = NumToString & " nine"            End Select            bNoFirstDigit = True        Case 1            Select Case nNumber Mod 10                Case 0: NumToString = NumToString & " ten"                Case 1: NumToString = NumToString & " eleven"                Case 2: NumToString = NumToString & " twelve"                Case 3: NumToString = NumToString & " thirteen"                Case 4: NumToString = NumToString & " fourteen"                Case 5: NumToString = NumToString & " fifteen"                Case 6: NumToString = NumToString & " sixteen"                Case 7: NumToString = NumToString & " seventeen"                Case 8: NumToString = NumToString & " eighteen"                Case 9: NumToString = NumToString & " nineteen"            End Select            bNoFirstDigit = True        Case 2: NumToString = NumToString & " twenty"        Case 3: NumToString = NumToString & " thirty"        Case 4: NumToString = NumToString & " forty"        Case 5: NumToString = NumToString & " fifty"        Case 6: NumToString = NumToString & " sixty"        Case 7: NumToString = NumToString & " seventy"        Case 8: NumToString = NumToString & " eighty"        Case 9: NumToString = NumToString & " ninety"    End Select    If Not bNoFirstDigit Then        If nNumber Mod 10 <> 0 Then            NumToString = NumToString & "-" & _                          Mid(NumToString(nNumber Mod 10), 2)        End If    End IfElse    Dim nTemp As Currency    nTemp = 10 ^ 12 'trillion    Do While nTemp >= 1        If nNumber >= nTemp Then            NumToString = NumToString & _                          NumToString(Int(nNumber / nTemp))            Select Case Int(Log(nTemp) / Log(10) + 0.5)                Case 12: NumToString = NumToString & " trillion"                Case 9: NumToString = NumToString & " billion"                Case 6: NumToString = NumToString & " million"                Case 3: NumToString = NumToString & " thousand"            End Select                       nNumber = nNumber - (Int(nNumber / nTemp) * nTemp)        End If        nTemp = nTemp / 1000    LoopEnd If If bNegative Then    NumToString = " negative" & NumToStringEnd If    End Function
Hoàng Sa là của Việt Nam!
Trường Sa là của Việt Nam!

"Nước Việt Nam là MỘT, dân tộc Việt Nam là MỘT,..."
---
Giọng ca vàng hát nhạc vàng: http://sannhac.com/tqt37c2.htm
microtri
Thành viên chính thức
Thành viên chính thức
Bài viết: 49
Ngày tham gia: Thứ 7 24/04/2010 3:37 am
Been thanked: 10 times

Function đổi số thành chữ Tiếng anh

Gửi bài by microtri »

Tên chương trình: Function đổi số thành chữ Tiếng anh
Ngôn ngữ lập trình: VB6
Tác giả: MicroTri
Chức năng: Chuyển số thành chữ
Đọc số lớn nhất 999 999 999 999
Có đơn vị lẽ
Vd:

Print doi_so(5550089.45, "Dollar", "Cent")
Print doi_so(89008.65, "Dollar", "Cent")
Print doi_so(17780089, "Dollar", "Cent")
Print doi_so(6220089.85, "Dollar", "Cent")

five million five hundred fifty thoundsand eighty nine Dollar And fourty five Cent
eighty nine thoundsand eight Dollar And sixty five Cent
seventeen million seven hundred eighty thoundsand eighty nine Dollar
six million two hundred twenty thoundsand eighty nine Dollar And eighty five Cent
Tập tin đính kèm
NumToStrEng.rar
(1.91 KiB) Đã tải về 710 lần
kuthao
Bài viết: 2
Ngày tham gia: Thứ 2 05/07/2010 4:32 pm

Re: Chuyển số thành chữ

Gửi bài by kuthao »

Lâu lắm không vào diễn đàn, quên luôn mật khẩu và email đã đăng ký nên phải đăng ký lại. :((

Code trên đọc số này 1000000100Một tỷ => Có vấn đề rồi anh truongphu à. Anh chỉnh sửa lại nhé!
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 527 times

Re: Chuyển số thành chữ

Gửi bài by truongphu »

kuthao đã viết:Code trên đọc số này 1000000100 là Một tỷ => Có vấn đề rồi anh truongphu à. Anh chỉnh sửa lại nhé!
Đúng, Cảm ơn bạn
Nhờ bạn sửa lại ở câu 65:

Mã: Chọn tất cả

If Num <> 0 And i > 2 And DuoiNgan = 0 And HàngÐvi = 0 And HàngChuc = 0 And HàngTram = 0 And Len(Chuôi) <= 12 Then Chuôi = ""
trở thành:
  1. If Num <> 0 And i > 2 And DuoiNgan = 0 And HàngÐvi = 0 And HàngChuc = 0 And HàngTram = 0 And Len(Chuôi) <= 12 Then Chuôi = Chuôi



Thật ra bài nầy tôi viết đã lâu, không nhớ cách vận hành. Phải rảnh rỗi và đọc lại từ từ mới tìm ra bug nên trả lời bạn chậm. Một lần nữa cảm ơn bạn
Tập tin đính kèm
Chuyên sô thành chu.rar
(1.76 KiB) Đã tải về 830 lần
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
ngaydautiendihoc
Thành viên danh dự
Thành viên danh dự
Bài viết: 262
Ngày tham gia: Thứ 2 12/03/2007 10:55 pm
Đến từ: Hà Giang
Has thanked: 2 times
Been thanked: 1 time
Tiếp xúc:

Re: Chuyển số thành chữ

Gửi bài by ngaydautiendihoc »

Code của bác truongphu đọc được số ngắn thế, có 10 chữ số thôi.
Em có lượm được 1 code cũng ngắn gọn, đọc được dãy số dài lê thê vì nó hoạt động trên nguyên tắc phân tích các nhóm 3 ký tự của 1 chuỗi, không có phép tính nên không hạn chế số lượng, thậm chí đọc được cả phần thập phân, mỗi tội em chưa biết đọc phần thập phân và các số khủng như thế nào cho đúng TIÊU CHUẨN VIỆT NAM.
Em xin gửi đoạn code em đã chỉnh sửa theo ý riêng, phần đọc số thập phân cũng tương tự nhưng do không cần dùng đến nên em đã bỏ.

Mã: Chọn tất cả

Function Num2Text(S As String) As String
    Dim So() As String
    Dim So1() As String
    Dim Hang() As String
    So() = Split("không mo.t hai ba bo'n nam sau bay tám chín", " ")
    So1 = Split("linh mo't tu lam mu'oi`i mu'o'i", " ")
    Hang = Split(" nghìn trie.u ty?", " ")
    Dim I, J, Donvi, Chuc, Tram As Integer
    Dim StrValue$, S1$
    Hang(0) = ""
    StrValue = ""
    For I = 1 To Len(S)
        If IsNumeric(Mid(S, I, 1)) Then
            S1 = S1 & Mid(S, I, 1)
        ElseIf Mid(S, I, 1) = "," Then
            Exit For
        End If
    Next
    S = S1
    If Len(S) = 0 Then Exit Function
    If S = "0" Then
        Num2Text = So(0)
        Exit Function
    End If
    While Left(S, 1) = "0"
        S = Right(S, Len(S) - 1)
    Wend
    I = Len(S)
    J = 0
    Do While I > 0
        Donvi = Int(Mid(S, I, 1))
        I = I - 1
        If I > 0 Then
            Chuc = Int(Mid(S, I, 1))
        Else
            Chuc = -1
        End If
        I = I - 1
        If I > 0 Then
            Tram = Int(Mid(S, I, 1))
        Else
            Tram = -1
        End If
        I = I - 1
        If Donvi > 0 Or Chuc > 0 Or Tram > 0 Or J = 3 Then
            StrValue = Hang(J) & " " & StrValue
        End If
        J = J + 1
        If J > 3 Then
            J = 1
        End If
        If Donvi = 1 And Chuc > 1 Then
            StrValue = So1(1) & " " & StrValue
        ElseIf Donvi = 4 And Chuc > 1 Then
            StrValue = So1(2) & " " & StrValue
        Else
            If Donvi = 5 And Chuc > 0 Then
                StrValue = So1(3) & " " & StrValue
            ElseIf Donvi > 0 Then
                StrValue = So(Donvi) & " " & StrValue
            End If
        End If
        If Chuc < 0 Then
            Exit Do
        Else
            If Chuc = 0 And Donvi > 0 Then
                StrValue = So1(0) & " " & StrValue
            ElseIf Chuc = 1 Then
                StrValue = So1(4) & " " & StrValue
            ElseIf Chuc > 1 Then
                StrValue = So(Chuc) & " " & So1(5) & " " & StrValue
            End If
        End If
        If Tram < 0 Then
            Exit Do
        Else
            If Tram > 0 Or Chuc > 0 Or Donvi > 0 Then
                StrValue = So(Tram) & " trăm " & StrValue
            End If
        End If
    Loop
    For I = 1 To 3
        StrValue = Replace(StrValue, Hang(I), Hang(I) & ",")
    Next
    StrValue = Replace(StrValue, ", " & Hang(3), " " & Hang(3))
    StrValue = Trim(StrValue)
    If Right(StrValue, 1) = "," Then StrValue = Left(StrValue, Len(StrValue) - 1)
    StrValue = UCase(Left(StrValue, 1)) & Right(StrValue, Len(StrValue) - 1)
    Num2Text = StrValue
End Function
Bác duyệt qua xem có ổn không ạ.
Sửa lần cuối bởi 1 vào ngày ngaydautiendihoc với 0 lần sửa trong tổng số.
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 527 times

Re: Chuyển số thành chữ

Gửi bài by truongphu »

Chào ngaydautiendihoc, lâu ngày thật!
ngaydautiendihoc đã viết:Code của bác truongphu đọc được số ngắn thế, có 10 chữ số thôi.
Do Function được cố ý định nghĩa là số Long
truongphu đã viết:Function BàngChu(Num As Long) '< 2147483647
Nếu muốn lớn hơn, cứ thử dùng Double

ngaydautiendihoc đã viết:Em có lượm được 1 code cũng ngắn gọn, đọc được dãy số dài lê thê
....
Bác duyệt qua xem có ổn không ạ.
dạo nầy tôi hơi bận nên đã lâu mới có dịp chạy thử function nầy, sau đây là kết quả:
untitled.JPG
Do vậy, code của bạn chưa dùng được. Rảnh rỗi bạn sửa lại xem
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
ngaydautiendihoc
Thành viên danh dự
Thành viên danh dự
Bài viết: 262
Ngày tham gia: Thứ 2 12/03/2007 10:55 pm
Đến từ: Hà Giang
Has thanked: 2 times
Been thanked: 1 time
Tiếp xúc:

Re: Chuyển số thành chữ

Gửi bài by ngaydautiendihoc »

truongphu đã viết:Do vậy, code của bạn chưa dùng được. Rảnh rỗi bạn sửa lại xem
Chào bác, em bận quá, lâu lâu mới ghé qua đây được.
Cái hàm của em chạy ngon trên các máy ở cơ quan em vì VBA hỗ trợ tiếng việt kém với lại có người thì dùng UNICODE có người lại dùng TCVN ... nên em phải lưu các chuỗi vào Setting và có chế độ cho người sử dụng tùy thích thay đổi. Vậy nên dòng code sau đây vẫn chạy đúng trên máy em còn trên máy bác sẽ không đúng.
StrValue = So(Tram) & " " & GetSetting("Number2Text", "QuyUoc", " 16") & " " & StrValue
Em xin sửa lại dòng trên như sau:
StrValue = So(Tram) & " trăm " & StrValue
Đăng trả lời

Quay về