Hàm đọc số thông minh

thanhan1234 · 11/12/08

tớ đang có 1 code đọc số, tại tớ sửa mấy cái nên bị lỗi bạn xem hộ với:
nếu cứ đọc số 1.000, 10.000, 100.000.000 là nó thành 2 lần ví dụ: Một triệu một triệu
Còn 1 ý tưởng nữa tớ muốn các bạn cùng làm thử là. Các bạn có thể sửa hàm này thành dạng thế này đc ko: doc_so(Number;Kytu)
Trong đó số Number là số cần đọc
Còn Kytu có dang text là lợi tiền cần đọc, Ví dụ doc_so(1000;"VND") --> một nghìn đồng
doc_so(1000;"USD") --> một nghìn đô la
doc_so(1000;"EUR") --> một nghìn eurô

==================== Code doc so ========================================
Public Function doc_so(tienvao)
Dim ketqua, sotien, nhom, chu, dich, s1, s2, s3 As String
Dim i, j, vitri As Byte, s As Double
Dim hang, doc, dem
tienvao = Int(tienvao)
If tienvao = 0 Then
ketqua = "Kh«ng"
Else
If Abs(tienvao) >= 1E+15 Then
ketqua = "Sè qu¸ lín."
Else
If tienvao <= 0 Then
ketqua = "Trõ" & Space(1)
Else
ketqua = Space(0)
End If
sotien = Abs(tienvao)
sotien = Right(Space(15) & sotien, 15)
hang = Array("none", "tr¨m", "m¬i", "kh¸c")
doc = Array("none", "ngµn tû", "tû", "triÖu", "ngh×n", "")
dem = Array("none", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chÝn")
For i = 1 To 5
nhom = Mid(sotien, i * 3 - 2, 3)
If nhom <> Space(3) Then
Select Case nhom
Case "000"
If i = 5 Then
chu = ""
End If
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 = "I" & 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 = "lÎ" & 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
doc_so = UCase(Left(ketqua, 1)) & Mid(ketqua, 2)
End Function
---------------

xichdragon · 11/12/08

Code đọc số thành chữ trên diễn đàn này khá nhiều. Bạn có thể kiếm lại.
Còn về đơn vị bạn có thể thêm tham số vào hàm
Public Function doc_so(tienvao, kytu)
....
Đoạn cuối:

doc_so = UCase(Left(ketqua, 1)) & Mid(ketqua, 2)
If kytu = 1 Then
doc_so = CStr(doc_so) & " VND"
Else
doc_so = CStr(doc_so) & " USD"
End If

Gluck

thanhan1234 · 11/12/08

Híc,cách của bạn thì nó đọc thành là: một triệu USD à hay một triệu VNĐ,... mình muốn đọc
một triệu đồng hoặc một triệu đô la , hay một triệu eurô cơ.
Mình sửa thế này mà vẫn ko đc, các bạn góp ý với.
phần in đậm là phần mình sửa.
Tức là code cũ là đọc VNĐ,
mình tùy biến là chỗ nào có chữ đồng mình sẽ thay thế bằng 1 trong 3 chữ là đồng hoặc đô la hoặc eurô.
Mình sử dụng biến tg ( biến trung gian)
và cách khai báo biến của mình ở hàm có đúng ko. Mình gà lắm, chưa biết nhiều về câu lệnh trong VB mà.
Bạn xem sửa lại giúp mình với.
Cám ơn nhiều.

============= code đã sửa =============
Public Function doc_so(tienvao, kytu As String)
Dim ketqua, sotien, nhom, chu, dich, s1, s2, s3, tg As String
Dim i, j, vitri As Byte, s As Double
Dim hang, doc, dem
If kytu = "VND" Then
tg = "®ång"
Else
If kytu = "USD" Then
tg = "®« la"
Else
tg = "eur«"
End If
End If
tienvao = Int(tienvao)
If tienvao = 0 Then
ketqua = "Kh«ng" & tg
Else
If Abs(tienvao) >= 1E+15 Then
ketqua = "Sè qu¸ lín."
Else
If tienvao <= 0 Then
ketqua = "Trõ" & Space(1)
Else
ketqua = Space(0)
End If
sotien = Abs(tienvao)
sotien = Right(Space(15) & sotien, 15)
hang = Array("none", "tr¨m", "m¬i", "kh¸c")
doc = Array("none", "ngµn tû", "tû", "triÖu", "ngµn", tg)
dem = Array("none", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chÝn")
For i = 1 To 5
nhom = Mid(sotien, i * 3 - 2, 3)
If nhom <> Space(3) Then
Select Case nhom
Case "000"
If i = 5 Then
chu = tg & "ch½n" & Space(1)
Else
chu = Space(0)
End If
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 = "I" & 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 = "lÎ" & 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
doc_so = UCase(Left(ketqua, 1)) & Mid(ketqua, 2)
End Function

BNTT · 11/12/08

Các bạn nên đọc bài này: http://www.giaiphapexcel.com/forum/showthread.php?t=1047
Và nên sử dụng sản phẩm của anh Tuân (miễn phí, cho nên đây không phải là chào hàng ăn huê hồng)
Tôi đã thử nghiệm, và thấy rằng Add-in này chạy rất tốt.

thanhan1234 · 12/12/08

Mình tìm quanh diễn đàn mà chưa thấy, bác nào có code đọc số thôi thật chuẩn, không cần chữ đồng chẵn, hay chữ đồng ở cuối câu. Còn mấy cái chữ đồng chẵn, hay đôla chẵn, hay euro chẵn gì đó mình sẽ thêm bằng câu lệnh if trong Excel cũng đc. Các bác cho mình code đó nhé.
Cám ơn các bác nhiều.

BNTT · 12/12/08

thanhan1234 đã viết:
Mình tìm quanh diễn đàn mà chưa thấy, bác nào có code đọc số thôi thật chuẩn, không cần chữ đồng chẵn, hay chữ đồng ở cuối câu. Còn mấy cái chữ đồng chẵn, hay đôla chẵn, hay euro chẵn gì đó mình sẽ thêm bằng câu lệnh if trong Excel cũng đc. Các bác cho mình code đó nhé.
Cám ơn các bác nhiều.

Bạn xem ở đây nha: http://www.giaiphapexcel.com/forum/showthread.php?t=1047
Bài trước của bạn hỏi, tôi đã chuyển vào trong đó.
Với cái Add-in của anh Tuân, bạn muốn thêm hay bỏ bớt chữ "đồng", chữ "chẵn" gì đó, thậm chí là dấu chấm cuối câu... tùy vào ý thích của bạn, không lệ thuộc vào Add-in.

ThuNghi · 12/12/08

thanhan1234 đã viết:
Mình tìm quanh diễn đàn mà chưa thấy, bác nào có code đọc số thôi thật chuẩn, không cần chữ đồng chẵn, hay chữ đồng ở cuối câu. Còn mấy cái chữ đồng chẵn, hay đôla chẵn, hay euro chẵn gì đó mình sẽ thêm bằng câu lệnh if trong Excel cũng đc. Các bác cho mình code đó nhé.
Cám ơn các bác nhiều.

Sửa lại cái UDF của bạn, các dòng mà đánh dấu ' là bỏ và thêm dòng dưới. UDF này dùng font TCVN và không có đọc số lẻ.

PHP:

Public Function docSo(tienvao) As String
Dim ketqua, nhom, sotien, chu, dich, s1, s2, s3  As String
Dim i, j, vitri As Byte, s As Double
Dim hang, doc, dem
'If kytu = "VND" Then
'      tg = "®ång"
'Else
'      If kytu = "USD" Then
'      tg = "®« la"
'      Else
'tg = "eur«"
'End If
'End If'
tienvao = Int(tienvao)
If tienvao = 0 Then
      ketqua = "Kh«ng" '& tg
End If
If Abs(tienvao) >= 1E+15 Then
      ketqua = "Sè qu¸ lín."
End If
If tienvao <= 0 Then
      ketqua = "Trõ" & Space(1)
Else
      ketqua = Space(0)
End If
sotien = Abs(tienvao)
sotien = Right(Space(15) & sotien, 15)
hang = Array("none", "tr¨m", "m¬i", "kh¸c")
'doc = Array("none", "ngµn tû", "tû", "triÖu", "ngµn", tg)'
doc = Array("none", "ngµn tû", "tû", "triÖu", "ngµn", " ")
dem = Array("none", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chÝn")
For i = 1 To 5
nhom = Mid(sotien, i * 3 - 2, 3)
    If nhom <> Space(3) Then
        Select Case nhom
        Case "000"
          If i = 5 Then
            'chu = tg & "ch½n" & Space(1)'
            chu = Space(1)
          Else
            chu = Space(0)
          End If
        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 = "I" & 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 = "lÎ" & 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
docSo = UCase(Left(ketqua, 1)) & Mid(ketqua, 2)
End Function

Cú pháp: Docso(...) & " dong"

thanhan1234 · 12/12/08

Cảm ơn bạn, chạy Ok rồi, Tuy nhiên, Khi mình dùng cú pháp Docso(...) & "dong" thì ở phần ghép có 2 ký tự trắng. Mình đã sửa đc rồi.
Phần này có khi bỏ hẳn đi bạn nhỉ. Vì mình không cần tận cùng là 5 hoặc 0 thì có chữ chẵn mà.
Case "000"
If i = 5 Then
'chu = tg & "ch½n" & Space(1)
chu = Space(0)
Else
chu = Space(0)
End If

anhlong · 22/10/09

Nhờ sữa add-in đổi số ra chữ.

Add-in đọc số của tôi (file đính kèm) đọc số ra chữ cực lẹ. Nhưng để công việc của mình nhập liệu nhanh , tôi không đánh 3 số 0 cuối mà dùng định dạng vị trí thập phân là 3 (Ví dụ tôi nhập 1234 thì ô Excel của tôi hiện là 1.234,000đ) Tôi muốn cái add-in này nó đọc thành (Một triệu hai trăm ba mươi bốn ngàn đồng (không có chữ chẳn)) ,Nhưng hiện tại "nó" cứ đọc là (Một ngàn hai trăm ba mươi bốn đồng chẳn) Có ai giúp tôi sữa code add-in này lại như ý tôi với.

ThuNghi · 23/10/09

anhlong đã viết:
Add-in đọc số của tôi (file đính kèm) đọc số ra chữ cực lẹ. Nhưng để công việc của mình nhập liệu nhanh , tôi không đánh 3 số 0 cuối mà dùng định dạng vị trí thập phân là 3 (Ví dụ tôi nhập 1234 thì ô Excel của tôi hiện là 1.234,000đ) Tôi muốn cái add-in này nó đọc thành (Một triệu hai trăm ba mươi bốn ngàn đồng (không có chữ chẳn)) ,Nhưng hiện tại "nó" cứ đọc là (Một ngàn hai trăm ba mươi bốn đồng chẳn) Có ai giúp tôi sữa code add-in này lại như ý tôi với.

Muốn nhập 1234 thành 1234000 thì bạn vào menu tools/options/edit/Fixed Decimal/Places bạn nhập vào số -3.
THeo tôi bạn không nên làm như vậy. Còn sửa code thì cũng dễ.
Khi bạn nhập 1234 nó sẽ đọc là (Một triệu hai trăm ba mươi bốn ngàn đồng) thì cũng dễ.

PHP:

Function vnd(ByVal NumCurrency As Currency) As String

Thêm câu
NumCurrency=NumCurrency*1000
Thành

PHP:

Function vnd(ByVal NumCurrency As Currency) As String
NumCurrency=NumCurrency*1000

Còn bỏ chữ chẵn thì dùng thêm hàm if ở dưới code.

PHP:

If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20") + ";63;68;1EB5;6E"

Bạn sửa câu sau thành

PHP:

If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20") + ""

anhlong · 23/10/09

ThuNghi đã viết:
Muốn nhập 1234 thành 1234000 thì bạn vào menu tools/options/edit/Fixed Decimal/Places bạn nhập vào số -3.

Chỉnh như bạn chỉ thì khi in ra nó có 3 số 0 đuôi đó luôn phải không bạn. Nhưng rồi mình muốn nhập "12 ngàn 3 trăm" thì đánh "12.300" hay có cách nhập như của tôi đánh "12,3" là được không bạn.

Hàm đọc số thông minh

thanhan1234

Thành viên mới

xichdragon

Thành viên hoạt động

thanhan1234

Thành viên mới

BNTT

Bùi Nguyễn Triệu Tường

thanhan1234

Thành viên mới

BNTT

Bùi Nguyễn Triệu Tường

ThuNghi

Hãy cho rồi sẽ nhận!

thanhan1234

Thành viên mới

anhlong

Thành viên mới

File đính kèm

ThuNghi

Hãy cho rồi sẽ nhận!

anhlong

Thành viên mới

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng