• 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

Hàm cho exel chuyển số ra chữ, không giống bên kế toán

Nơi trao đổi về VBA (Visual Basic for Application), lập trình cho ứng dụng Microsoft Office, AutoCAD...

Moderator: tungblt

huyndh
Posts: 2
Joined: Fri 14/08/2015 10:21 am

Hàm cho exel chuyển số ra chữ, không giống bên kế toán

Postby huyndh » Fri 14/08/2015 11:27 am

Mình thường nhập điểm cho thí sinh, ngoài điểm bằng số phải nhập điểm bằng chữ. VD như 5,5 ghi thành năm phẩy năm.
Các bạn có cách nào giúp mình chỗ này không, mình cop đc code chuyển số ra chữ bên kế toán mà không biết sửa như thế nào. Đau đầu lắm các bạn ạ
Em nó đây

  1. Function DocSoVni(conso) As String
  2. s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
  3. lop3 = Array("", " trieäu", " nghìn", " tyû")
  4. If Trim(conso) = "" Then
  5. DocSoVni = ""
  6. ElseIf IsNumeric(conso) = True Then
  7. If conso < 0 Then dau = "aâm " Else dau = ""
  8. conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  9. conso = " " & conso
  10. conso = Replace(conso, ",", "", 1)
  11. vt = InStr(1, conso, "E")
  12. If vt > 0 Then
  13. sonhan = Val(Mid(conso, vt + 1))
  14. conso = Trim(Mid(conso, 2, vt - 2))
  15. conso = conso & String(sonhan - Len(conso) + 1, "0")
  16. End If
  17. conso = Trim(conso)
  18. sochuso = Len(conso) Mod 9
  19. If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  20. docso = ""
  21. i = 1
  22. lop = 1
  23. Do
  24. n1 = Mid(conso, i, 1)
  25. n2 = Mid(conso, i + 1, 1)
  26. n3 = Mid(conso, i + 2, 1)
  27. baso = Mid(conso, i, 3)
  28. i = i + 3
  29. If n1 & n2 & n3 = "000" Then
  30. If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tyû" Else s123 = ""
  31. Else
  32. If n1 = 0 Then
  33. If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
  34. Else
  35. s1 = s09(n1) & " traêm"
  36. End If
  37. If n2 = 0 Then
  38. If s1 = "" Or n3 = 0 Then
  39. s2 = ""
  40. Else
  41. s2 = " linh"
  42. End If
  43. Else
  44. If n2 = 1 Then s2 = " möôøi" Else s2 = s09(n2) & " möôi"
  45. End If
  46. If n3 = 1 Then
  47. If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
  48. ElseIf n3 = 5 And n2 <> 0 Then
  49. s3 = " laêm"
  50. Else
  51. s3 = s09(n3)
  52. End If
  53. If i > Len(conso) Then
  54. s123 = s1 & s2 & s3
  55. Else
  56. s123 = s1 & s2 & s3 & lop3(lop)
  57. End If
  58. End If
  59. lop = lop + 1
  60. If lop > 3 Then lop = 1
  61. docso = docso & s123
  62. If i > Len(conso) Then Exit Do
  63. Loop
  64. If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
  65. Else
  66. DocSoVni = conso
  67. End If
  68. End Function
  69. Function DocSoUni(conso) As String
  70. 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")
  71. lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
  72. 'Stop
  73. If Trim(conso) = "" Then
  74. DocSoUni = ""
  75. ElseIf IsNumeric(conso) = True Then
  76. If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
  77. conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  78. conso = " " & conso
  79. conso = Replace(conso, ",", "", 1)
  80. vt = InStr(1, conso, "E")
  81. If vt > 0 Then
  82. sonhan = Val(Mid(conso, vt + 1))
  83. conso = Trim(Mid(conso, 2, vt - 2))
  84. conso = conso & String(sonhan - Len(conso) + 1, "0")
  85. End If
  86. conso = Trim(conso)
  87. sochuso = Len(conso) Mod 9
  88. If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  89. docso = ""
  90. i = 1
  91. lop = 1
  92. Do
  93. n1 = Mid(conso, i, 1)
  94. n2 = Mid(conso, i + 1, 1)
  95. n3 = Mid(conso, i + 2, 1)
  96. baso = Mid(conso, i, 3)
  97. i = i + 3
  98. If n1 & n2 & n3 = "000" Then
  99. If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
  100. Else
  101. If n1 = 0 Then
  102. If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
  103. Else
  104. s1 = s09(n1) & " tr" & ChrW(259) & "m"
  105. End If
  106. If n2 = 0 Then
  107. If s1 = "" Or n3 = 0 Then
  108. s2 = ""
  109. Else
  110. s2 = " linh"
  111. End If
  112. Else
  113. If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
  114. End If
  115. If n3 = 1 Then
  116. If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
  117. ElseIf n3 = 5 And n2 <> 0 Then
  118. s3 = " l" & ChrW(259) & "m"
  119. Else
  120. s3 = s09(n3)
  121. End If
  122. If i > Len(conso) Then
  123. s123 = s1 & s2 & s3
  124. Else
  125. s123 = s1 & s2 & s3 & lop3(lop)
  126. End If
  127. End If
  128. lop = lop + 1
  129. If lop > 3 Then lop = 1
  130. docso = docso & s123
  131. If i > Len(conso) Then Exit Do
  132. Loop
  133. If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
  134. Else
  135. DocSoUni = conso
  136. End If
  137. End Function
  138.  



User avatar
xuanha
Guru
Guru
Posts: 1230
Joined: Thu 19/08/2010 4:25 pm
Location: Ban Tổ chức Thành uỷ Hưng Yên, tỉnh Hưng Yên
Has thanked: 13 times
Been thanked: 380 times
Contact:

Re: Hàm cho exel chuyển số ra chữ, không giống bên kế toán

Postby xuanha » Tue 08/09/2015 11:10 am

Xây dựng hàm
  1. Function Doi(so$) As String
  2. chu = Array("", "m" & ChrW(7897) & "t", "hai", "ba", "b" & ChrW(7889) & "n", "n" & ChrW(259) & "m", "s" & Chr(225) & "u", "b" & ChrW(7849) & "y", "t" & ChrW(225) & "m", "ch" & ChrW(237) & "n", "m" & ChrW(432) & ChrW(7901) & "i")
  3. Dim a$(): a = Split(so, ",")
  4. If UBound(a) > 0 Then
  5. Doi = chu(a(0)) & " ph" & ChrW(7849) & "y " & chu(a(1))
  6. Else
  7. Doi = chu(a(0))
  8. End If
  9. End Function

Gọi hàm:
[vb]=Doi(A1)[/vb]
Kiểm phiếu Đại hội Đoàn, Đại hội Đảng
http://caulacbovb.com/forum/viewtopic.php?t=23599


Return to “Visual Basic for Application (VBA)”

Who is online

Users browsing this forum: No registered users and 2 guests