Mong anh/chị giúp đỡ: Chỉnh sửa hàm đổi số sang chữ (1 người xem)

[ductutq]

Em tìm trên GPE được rất nhiều code đổi số sang chữ nhưng máy em đều bị lỗi. Cuối cùng em tìm được code này thì không bị lỗi. Nhưng code này có một vấn đề là nó tự làm tròn phần số lẻ. VD: Em đổi 1403,4 thì nó thành Một nghìn bốn trăm linh ba hoặc 1403,5 thì thành Một nghìn bốn trăm linh bốn. Giờ em muốn đổi 1403,4 thành Một nghìn bốn trăm linh ba phẩy bốn mươi. Mong anh/chị sửa code giúp em với. Em kém quá không biết sửa thế nào

Public Function docso(chuyenso) As String
s09 = Array("", " 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")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(chuyenso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(chuyenso) = True Then
If chuyenso < 0 Then dau = ChrW(226) & "m " Else dau = ""
chuyenso = Application.WorksheetFunction.Round(Abs(chuyenso), 0)
chuyenso = " " & chuyenso
chuyenso = Replace(chuyenso, ",", "", 1)
vt = InStr(1, chuyenso, "E")
If vt > 0 Then
sonhan = Val(Mid(chuyenso, vt + 1))
chuyenso = Trim(Mid(chuyenso, 2, vt - 2))
chuyenso = chuyenso & String(sonhan - Len(chuyenso) + 1, "0")
End If
chuyenso = Trim(chuyenso)
sochuso = Len(chuyenso) Mod 9
If sochuso > 0 Then chuyenso = String(9 - (sochuso Mod 12), "0") & chuyenso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(chuyenso, i, 1)
n2 = Mid(chuyenso, i + 1, 1)
n3 = Mid(chuyenso, i + 2, 1)
baso = Mid(chuyenso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(chuyenso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " M" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " M" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(chuyenso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(chuyenso) Then Exit Do
Loop
If docso = "" Then docso = "kh" & ChrW(244) & "ng" Else docso = dau & Trim(docso)
Else
docso = chuyenso
End If
End Function

 

[giaiphap]

Em tìm trên GPE được rất nhiều code đổi số sang chữ nhưng máy em đều bị lỗi. Cuối cùng em tìm được code này thì không bị lỗi. Nhưng code này có một vấn đề là nó tự làm tròn phần số lẻ. VD: Em đổi 1403,4 thì nó thành Một nghìn bốn trăm linh ba hoặc 1403,5 thì thành Một nghìn bốn trăm linh bốn. Giờ em muốn đổi 1403,4 thành Một nghìn bốn trăm linh ba phẩy bốn mươi. Mong anh/chị sửa code giúp em với. Em kém quá không biết sửa thế nào

Public Function docso(chuyenso) As String
s09 = Array("", " 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")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(chuyenso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(chuyenso) = True Then
If chuyenso < 0 Then dau = ChrW(226) & "m " Else dau = ""
chuyenso = Application.WorksheetFunction.Round(Abs(chuyenso), 0)
chuyenso = " " & chuyenso
chuyenso = Replace(chuyenso, ",", "", 1)
vt = InStr(1, chuyenso, "E")
If vt > 0 Then
sonhan = Val(Mid(chuyenso, vt + 1))
chuyenso = Trim(Mid(chuyenso, 2, vt - 2))
chuyenso = chuyenso & String(sonhan - Len(chuyenso) + 1, "0")
End If
chuyenso = Trim(chuyenso)
sochuso = Len(chuyenso) Mod 9
If sochuso > 0 Then chuyenso = String(9 - (sochuso Mod 12), "0") & chuyenso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(chuyenso, i, 1)
n2 = Mid(chuyenso, i + 1, 1)
n3 = Mid(chuyenso, i + 2, 1)
baso = Mid(chuyenso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(chuyenso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " M" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " M" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(chuyenso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(chuyenso) Then Exit Do
Loop
If docso = "" Then docso = "kh" & ChrW(244) & "ng" Else docso = dau & Trim(docso)
Else
docso = chuyenso
End If
End Function

Xem thử cách củ chuối này đi.

 

[ductutq]

Em gắn thử add-in trên nhưng mà kết quả vẫn bị làm tròn Anh có thể viết rõ câu lệnh sửa đổi để em thử chạy module xem kết quả có khác được không ạ?

 

[giaiphap]

Em gắn thử add-in trên nhưng mà kết quả vẫn bị làm tròn Anh có thể viết rõ câu lệnh sửa đổi để em thử chạy module xem kết quả có khác được không ạ?

Bạn xem lại coi rõ ràng nó đâu có làm tròn. dấu ngăn cách phần lẻ là dấu ",", còn nếu là dấu "." thì bạn sửa chổ màu đỏ trong code này:

If WorksheetFunction.Find([COLOR=#ff0000]","[/COLOR], m) <> 0 Then

 

[ductutq]

Bạn xem lại coi rõ ràng nó đâu có làm tròn. dấu ngăn cách phần lẻ là dấu ",", còn nếu là dấu "." thì bạn sửa chổ màu đỏ trong code này:

If WorksheetFunction.Find([COLOR=#ff0000]","[/COLOR], m) <> 0 Then

Code trên của a thay vào chỗ nào vậy ạ? Em gần như mù về cái này e thử nhiều add-in trên GPE một số cái bị lỗi NAME, một số lại bị lỗi VALUE. Chỉ dùng cái trên kia ra là kết quả mà nó thiếu phần thập phân. Không biết phải do máy cài thiếu cái gì không.

 

[giaiphap]

Code trên của a thay vào chỗ nào vậy ạ? Em gần như mù về cái này e thử nhiều add-in trên GPE một số cái bị lỗi NAME, một số lại bị lỗi VALUE. Chỉ dùng cái trên kia ra là kết quả mà nó thiếu phần thập phân. Không biết phải do máy cài thiếu cái gì không.

Bạn tải file ở #2 và xem code tìm dòng If WorksheetFunction.Find(",", m) <> 0 Then

 

[sealand]

Thấy không cần thiết nên sửa lại