• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Chuyển số thành chữ

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

Chuyển số thành chữ

Gửi bàigửi bởi truongphu » T.Ba 01/04/2008 3:03 pm

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 người dùng
ongdat76
Guru
Guru
Bài viết: 82
Ngày tham gia: T.Năm 09/03/2006 10:11 am
Đến từ: Thành phố Vinh - Nghệ An
Has thanked: 1 time
Been thanked: 2 time
Liên hệ:

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

Gửi bàigửi bởi ongdat76 » T.Năm 03/04/2008 3:12 pm

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

Mã: Chọn hết

  1. Public Function NumToString(ByVal nNumber As Currency) As String
  2.  
  3. Dim bNegative As Boolean
  4. Dim bHundred As Boolean
  5.  
  6. If nNumber < 0 Then
  7.     bNegative = True
  8. End If
  9.  
  10. nNumber = Abs(Int(nNumber))
  11.  
  12. If nNumber < 1000 Then
  13.     If nNumber \ 100 > 0 Then
  14.         NumToString = NumToString & _
  15.              NumToString(nNumber \ 100) & " hundred"
  16.         bHundred = True
  17.     End If
  18.     nNumber = nNumber - ((nNumber \ 100) * 100)
  19.     Dim bNoFirstDigit As Boolean
  20.     bNoFirstDigit = False
  21.     Select Case nNumber \ 10
  22.         Case 0
  23.             Select Case nNumber Mod 10
  24.                 Case 0
  25.                     If Not bHundred Then
  26.                         NumToString = NumToString & " zero"
  27.                     End If
  28.                 Case 1: NumToString = NumToString & " one"
  29.                 Case 2: NumToString = NumToString & " two"
  30.                 Case 3: NumToString = NumToString & " three"
  31.                 Case 4: NumToString = NumToString & " four"
  32.                 Case 5: NumToString = NumToString & " five"
  33.                 Case 6: NumToString = NumToString & " six"
  34.                 Case 7: NumToString = NumToString & " seven"
  35.                 Case 8: NumToString = NumToString & " eight"
  36.                 Case 9: NumToString = NumToString & " nine"
  37.             End Select
  38.             bNoFirstDigit = True
  39.         Case 1
  40.             Select Case nNumber Mod 10
  41.                 Case 0: NumToString = NumToString & " ten"
  42.                 Case 1: NumToString = NumToString & " eleven"
  43.                 Case 2: NumToString = NumToString & " twelve"
  44.                 Case 3: NumToString = NumToString & " thirteen"
  45.                 Case 4: NumToString = NumToString & " fourteen"
  46.                 Case 5: NumToString = NumToString & " fifteen"
  47.                 Case 6: NumToString = NumToString & " sixteen"
  48.                 Case 7: NumToString = NumToString & " seventeen"
  49.                 Case 8: NumToString = NumToString & " eighteen"
  50.                 Case 9: NumToString = NumToString & " nineteen"
  51.             End Select
  52.             bNoFirstDigit = True
  53.         Case 2: NumToString = NumToString & " twenty"
  54.         Case 3: NumToString = NumToString & " thirty"
  55.         Case 4: NumToString = NumToString & " forty"
  56.         Case 5: NumToString = NumToString & " fifty"
  57.         Case 6: NumToString = NumToString & " sixty"
  58.         Case 7: NumToString = NumToString & " seventy"
  59.         Case 8: NumToString = NumToString & " eighty"
  60.         Case 9: NumToString = NumToString & " ninety"
  61.     End Select
  62.     If Not bNoFirstDigit Then
  63.         If nNumber Mod 10 <> 0 Then
  64.             NumToString = NumToString & "-" & _
  65.                           Mid(NumToString(nNumber Mod 10), 2)
  66.         End If
  67.     End If
  68. Else
  69.     Dim nTemp As Currency
  70.     nTemp = 10 ^ 12 'trillion
  71.     Do While nTemp >= 1
  72.         If nNumber >= nTemp Then
  73.             NumToString = NumToString & _
  74.                           NumToString(Int(nNumber / nTemp))
  75.             Select Case Int(Log(nTemp) / Log(10) + 0.5)
  76.                 Case 12: NumToString = NumToString & " trillion"
  77.                 Case 9: NumToString = NumToString & " billion"
  78.                 Case 6: NumToString = NumToString & " million"
  79.                 Case 3: NumToString = NumToString & " thousand"
  80.             End Select
  81.            
  82.             nNumber = nNumber - (Int(nNumber / nTemp) * nTemp)
  83.         End If
  84.         nTemp = nTemp / 1000
  85.     Loop
  86. End If
  87.  
  88. If bNegative Then
  89.     NumToString = " negative" & NumToString
  90. End If
  91.    
  92. 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: T.Bảy 24/04/2010 3:37 am
Been thanked: 10 time

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

Gửi bàigửi bởi microtri » T.Ba 25/05/2010 10:55 am

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 643 lần

kuthao
Bài viết: 2
Ngày tham gia: T.Hai 05/07/2010 4:32 pm

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

Gửi bàigửi bởi kuthao » T.Hai 05/07/2010 4:38 pm

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 người dùng
truongphu
VIP
VIP
Bài viết: 4761
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 515 time

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

Gửi bàigửi bởi truongphu » CN 11/07/2010 8:40 pm

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 hết

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



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 735 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: 261
Ngày tham gia: T.Hai 12/03/2007 10:55 pm
Đến từ: Hà Giang
Has thanked: 2 time
Been thanked: 1 time
Liên hệ:

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

Gửi bàigửi bởi ngaydautiendihoc » T.Ba 10/08/2010 12:33 am

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 hết

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 ngaydautiendihoc vào ngày T.Bảy 14/08/2010 11:22 am với 1 lần sửa.

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4761
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 515 time

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

Gửi bàigửi bởi truongphu » T.Sáu 13/08/2010 8:56 am

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: 261
Ngày tham gia: T.Hai 12/03/2007 10:55 pm
Đến từ: Hà Giang
Has thanked: 2 time
Been thanked: 1 time
Liên hệ:

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

Gửi bàigửi bởi ngaydautiendihoc » T.Bảy 14/08/2010 11:22 am

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


Quay về “[VB] Chuỗi và Thời gian”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.0 khách