-
Cần giúp đỡ chuyển số có thập phân ra chữ
ledangvan > 15-09-16, 10:03 AM
Mình đã tìm trên nhóm các cách đổi số ra chữ, tuy nhiên các bài viết chỉ với các số nguyên (123456), mình muốn các bạn giúp đỡ hàm để chuyển số có chữ số thập phân ra chữ (123456,88).
Xin trân trọng cảm ơn. -
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
lmthu > 15-09-16, 10:37 AM
Thông thường trong thực tế người ta chỉ lấy phần thập phân khoảng 2-3 số là cùng nên theo yêu cầu của bạn ta chỉ cần làm như sau:
VD ta có số i=1254,185 cần đọc số này thành chữ
Ta có 1 hàm đọc số là Docso (cái này bạn tự tìm)
ta khai báo 2 biến kiểu Double là songuyen và thapphan
songuyen=ind(i) 'chia lấy phần nguyên
thapphan=mod(i) 'chia lấy phần thập phân
Đọc số thành chữ=Docso(songuyen) & " phẩy " & Docso(thapphan) -
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
ongke0711 > 15-09-16, 01:48 PM
Thích cái cách giải quyết này của bạn lmthu. Đúng là think out the box.
-
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
Nguyen Hoang Diep > 15-09-16, 03:59 PM
Bạn thử code này xem sao nhé.
Function TIENLE(TienSo)
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 TienSo = 0 Then
Ketqua = "Kh" & ChrW$(244) & "ng m" & ChrW$(233) & "t vu" & ChrW$(244) & "ng./."
Else
If Abs(TienSo) >= 1E+15 Then
Ketqua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam"
Else
If TienSo < 0 Then
Ketqua = ChrW$(194) & "m" & Space(1)
Else
Ketqua = Space(0)
End If
SoTien = Format(Abs(TienSo), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("Kh" & ChrW$(244) & "ng", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("Kh" & ChrW$(244) & "ng", "ng" & ChrW$(224) & "n t" & ChrW$(272), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", "ph" & ChrW$(7849) & "y", ChrW$(273) & ChrW$(7891) & "ng") 'ChrW$(273) & ChrW$(7891) & "ng"
Dem = Array("Kh" & ChrW$(244) & "ng", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7843) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "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 = "ph" & ChrW$(7849) & "y" & Space(1) ''ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "kh" & ChrW$(244) & "ng kh" & ChrW$(244) & "ng" & ChrW$(273) & ChrW$(7891) & "ng" ''ChrW$(233) & "t vu" & ChrW$(244) & "ng./."
Case ",00"
Chu = "kh" & ChrW$(244) & "ng kh" & ChrW$(244) & "ng" & ChrW$(273) & ChrW$(7891) & "ng" ''ChrW$(233) & "t vu" & ChrW$(244) & "ng./."
Case Else
Chu = ""
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 1 And S = 0 And S2 = 0 And S3 <> 0
If (S1 = 0 And S2 = 0 And i = 2 Or S1 = 0 And S2 = 0 And i = 3 Or S1 = 0 And S2 = 0 And i = 4 Or S1 = 0 And S2 = 0 And i = 5) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m l" & ChrW$(7867) & Space(1)
End If
Case 1 And S = 0 And S2 <> 0 And S3 <> 0
If S1 = 0 And (i = 2 Or i = 3 Or i = 4 Or i = 5 Or i = 6) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m "
End If
Case 1 And S = 0 And S2 <> 0 And S3 = 0
If S1 = 0 And (i = 2 Or i = 3 Or i = 4 Or i = 5 Or i = 6) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m "
End If
Case 1 And S1 = 0 And S2 = 0 And S3 = 0
If (i = 4 And S1 = 0 And S2 = 0 And S3 = 0) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m ph" & ChrW$(7849) & "y"
End If
Case 2 And S = 1
Dich = "m" & ChrW$(432) & ChrW$(7901) & "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 = 0 And S2 = 0 And S3 = 0 Or (S1 <> 0 And S2 = 0 And S3 <> 0) Then
Dich = "l" & ChrW$(7867) & Space(1)
Else
If (S1 = 0 And S2 = 0 And S3 <> 0 And i = 4) Then
Dich = Space(0)
Else
If (S1 >= 1 And S1 <= 9) Or S2 = 0 Then
Dich = "kh" & ChrW$(244) & "ng "
End If
End If
End If
End Select
Chu = Chu & Dich
Next j
End Select
Vitri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
Ketqua = Ketqua & Chu
End If
Next i
End If
End If
TIENLE = UCase(Left(Ketqua, 1)) & Mid(Ketqua, 2)
End Function
-
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
ledangvan > 16-09-16, 10:05 AM
(15-09-16, 03:59 PM)Nguyen Hoang Diep Đã viết: Bạn thử code này xem sao nhé.
Function TIENLE(TienSo)
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 TienSo = 0 Then
Ketqua = "Kh" & ChrW$(244) & "ng m" & ChrW$(233) & "t vu" & ChrW$(244) & "ng./."
Else
If Abs(TienSo) >= 1E+15 Then
Ketqua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam"
Else
If TienSo < 0 Then
Ketqua = ChrW$(194) & "m" & Space(1)
Else
Ketqua = Space(0)
End If
SoTien = Format(Abs(TienSo), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("Kh" & ChrW$(244) & "ng", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("Kh" & ChrW$(244) & "ng", "ng" & ChrW$(224) & "n t" & ChrW$(272), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", "ph" & ChrW$(7849) & "y", ChrW$(273) & ChrW$(7891) & "ng") 'ChrW$(273) & ChrW$(7891) & "ng"
Dem = Array("Kh" & ChrW$(244) & "ng", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7843) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "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 = "ph" & ChrW$(7849) & "y" & Space(1) ''ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "kh" & ChrW$(244) & "ng kh" & ChrW$(244) & "ng" & ChrW$(273) & ChrW$(7891) & "ng" ''ChrW$(233) & "t vu" & ChrW$(244) & "ng./."
Case ",00"
Chu = "kh" & ChrW$(244) & "ng kh" & ChrW$(244) & "ng" & ChrW$(273) & ChrW$(7891) & "ng" ''ChrW$(233) & "t vu" & ChrW$(244) & "ng./."
Case Else
Chu = ""
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 1 And S = 0 And S2 = 0 And S3 <> 0
If (S1 = 0 And S2 = 0 And i = 2 Or S1 = 0 And S2 = 0 And i = 3 Or S1 = 0 And S2 = 0 And i = 4 Or S1 = 0 And S2 = 0 And i = 5) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m l" & ChrW$(7867) & Space(1)
End If
Case 1 And S = 0 And S2 <> 0 And S3 <> 0
If S1 = 0 And (i = 2 Or i = 3 Or i = 4 Or i = 5 Or i = 6) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m "
End If
Case 1 And S = 0 And S2 <> 0 And S3 = 0
If S1 = 0 And (i = 2 Or i = 3 Or i = 4 Or i = 5 Or i = 6) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m "
End If
Case 1 And S1 = 0 And S2 = 0 And S3 = 0
If (i = 4 And S1 = 0 And S2 = 0 And S3 = 0) Then
Dich = "kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m ph" & ChrW$(7849) & "y"
End If
Case 2 And S = 1
Dich = "m" & ChrW$(432) & ChrW$(7901) & "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 = 0 And S2 = 0 And S3 = 0 Or (S1 <> 0 And S2 = 0 And S3 <> 0) Then
Dich = "l" & ChrW$(7867) & Space(1)
Else
If (S1 = 0 And S2 = 0 And S3 <> 0 And i = 4) Then
Dich = Space(0)
Else
If (S1 >= 1 And S1 <= 9) Or S2 = 0 Then
Dich = "kh" & ChrW$(244) & "ng "
End If
End If
End If
End Select
Chu = Chu & Dich
Next j
End Select
Vitri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
Ketqua = Ketqua & Chu
End If
Next i
End If
End If
TIENLE = UCase(Left(Ketqua, 1)) & Mid(Ketqua, 2)
End Function
Cảm ơn Nguyen Hoang Diep
[url=http://thuthuataccess.com/forum/user-17579.html][/url]Tuy nhiên kết quả dịch ra chưa được theo ý muốn, ví dụ : 12800,4 kết quả dịch ra là : Mười hai nghìn tám trăm phẩy bốn mươi đồng.
Mình muốn kết quả dịch là : Mười hai nghìn, tám trăm phẩy bốn đồng. (Tách dấu phẩy và phần sau dấu phẩy thể hiện là phẩy bốn chứ không phải phẩy bốn mươi)
Rất mong bạn trợ giúp -
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
maidinhdan > 16-09-16, 04:43 PM
(16-09-16, 10:05 AM)ledangvan Đã viết: Cảm ơn Nguyen Hoang Diep
Tuy nhiên kết quả dịch ra chưa được theo ý muốn, ví dụ : 12800,4 kết quả dịch ra là : Mười hai nghìn tám trăm phẩy bốn mươi đồng.
Mình muốn kết quả dịch là : Mười hai nghìn, tám trăm phẩy bốn đồng. (Tách dấu phẩy và phần sau dấu phẩy thể hiện là phẩy bốn chứ không phải phẩy bốn mươi)
Rất mong bạn trợ giúp
Xin tham gia 1 bài:
Gửi anh Code này:
Mã PHP:Public Function Docso2(Number As Double)
Dim MyArray
Dim Str As String
If Number >= 1E+18 Then Docso2 = "#NUM!": Exit Function
Str = Format(Fix(Abs(Number)), "000000000000000000")
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ", ChrW(273) & ChrW(7891) & "ng ", " ph" & ChrW(7849) & "y ", "xu ")
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
Docso2 = Docso2 & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
Docso2 = Docso2 & MyArray(12)
End If
Next
Docso2 = IIf(Number = 0, MyArray(0) & MyArray(30), "") & IIf(Fix(Number) <> 0, Docso2 & MyArray(30), "") & IIf(Fix(Number) <> 0 And Fix(Number) <> Number, MyArray(31), "") & IIf(Fix(Number) <> Number, IIf(Abs(Number - Fix(Number)) < 0.1, "", MyArray(Left(Right(Format(Abs(Number), "#.00"), 2), 1)) & MyArray(17)) & MyArray(Right(Format(Number, "#.00"), 1)) & MyArray(32), "")
Docso2 = Replace(Trim(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Docso2, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)), ", " & MyArray(30), " " & MyArray(30))), MyArray(30) & MyArray(31), Split(MyArray(30), " ")(0) & " " & MyArray(31))
If Number < 0 Then Docso2 = MyArray(29) & Docso2
Docso2 = UCase(Left(Docso2, 1)) & Mid(Docso2, 2) & "."
End Function
Ví dụ:
+ 100,000,500.25 : Một trăm triệu, năm trăm đồng phẩy hai mươi lăm xu.
+ 10,250,000.51 : Mười triệu, hai trăm năm mươi ngàn đồng phẩy năm mươi mốt xu.
+ 10,500.20 : Mười ngàn, năm trăm đồng phẩy hai mươi xu. ( Trường hợp .20 Xu không muốn hiện chữ " hai mươi xu" thì thay đoạn cuối cùng Mid(Docso2, 2) = > Mid(Docso2, 1) nhưng phải chèn thêm hàm if cho tương xứng khi bắt điều kiện
Chú ý dòng: MyArray = Array... ( Mãng MyArray có tất cả 31 phần tử. thứ tự thì anh tự tùy biến dựa vào 31 phần tử này), Theo mình với đoạn code này nên thay phần tử thứ 30 (" ph" & ChrW(7849) & "y ") thành chữ "và " là hay nhất. Và nó sẽ cho kết quả như sau:
+ 1,005,000.13 : Một triệu, không trăm lẻ năm ngàn đồng và mười ba xu.
+ 12,800.40 : Mười hai ngàn, tám trăm đồng và bốn mươi xu.
Thân mến! -
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
vuthaiha90 > 19-09-16, 11:40 AM
Các bác có thể demo cho em bản ứng dụng đọc mét vuông thập phân được không ạ. VD: 12,5 Mười hai phẩy năm mét vuông 13: Mười ba mét vuông -
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
Nguyen Hoang Diep > 19-09-16, 02:44 PM
Bạn thử xem nhé.
http://www.mediafire.com/download/7q2s8b...enDT.accdb -
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
vuthaiha90 > 19-09-16, 06:01 PM
(19-09-16, 02:44 PM)Nguyen Hoang Diep Đã viết: Bạn thử xem nhé.
http://www.mediafire.com/download/7q2s8b...enDT.accdb
Em cảm ơn bác, để em kéo về ứng dụng vào chương trình của em -
RE: Cần giúp đỡ chuyển số có thập phân ra chữ
jeck09nt > 20-09-16, 09:27 AM
(19-09-16, 06:01 PM)vuthaiha90 Đã viết:
(19-09-16, 02:44 PM)Nguyen Hoang Diep Đã viết: Bạn thử xem nhé.
http://www.mediafire.com/download/7q2s8b...enDT.accdb
Em cảm ơn bác, để em kéo về ứng dụng vào chương trình của em
Chào Hoàng Diệp
Sao minh mở report không được, báo lỗi Parameter Value
Bạn xem lại giúp nhé ! hoặc cho đọc số trên Form luôn ah.