Code chuyển số thành chữ ( thành tiền) ! (1 người xem)

[Loan Châu]

Kính chào quý anh chị !
Tôi đang gặp rắc rối trong công việc mong quý anh chị giúp đỡ.
Đó là tôi muốn đổi các số ra thành chữ trong trong tính tiền.
ví dụ là 25000 = Hai lăm nghìn đồng chẵn.
Tôi có thử một số các tool trên mạng nhưng hay bị lỗi font quá.
Tôi rất mong nhận được sự giúp đở của quý anh chị.
Tôi cảm ơn quý anh chị trước !
Trân trọng,
Loan Châu

 

[ndu96081631]

anh befaint đừng la em tội nghiệp anh. huhu, em viết nó cứ lỗi font.

Lấy hàm này về xài thử:

Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
  Dim MyArray
  Dim Str
  Str = Format(Abs(Number), "000000000000000000")
  Select Case Font
  Case 1
    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 ")
  Case 2
    MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
  Case 3
    MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
  End Select
  If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2))
    Exit Function
  End If
  Dim i As Long
  For i = 1 To Len(Str)
    If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
      DocSo = DocSo & 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
      DocSo = DocSo & MyArray(12)
    End If
  Next
  DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
  If Number < 0 Then
    DocSo = MyArray(29) & DocSo
  End If
  DocSo = Replace(Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & "*", ",*", ""), "*", "")
End Function

Cú pháp
=DocSo(Số,1) ---> Dùng cho bảng mã Unicode
=DocSo(Số,2) ---> Dùng cho bảng mã VNI-Windows
=DocSo(Số,3) ---> Dùng cho bảng mã TCVN3
-----------------------------------------
Tôi lưu hàm này trong máy tính lâu rồi. Nhớ không lầm là của @huuthang_bd

 

[Loan Châu]

Lấy hàm này về xài thử:

Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
  Dim MyArray
  Dim Str
  Str = Format(Abs(Number), "000000000000000000")
  Select Case Font
  Case 1
    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 ")
  Case 2
    MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
  Case 3
    MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
  End Select
  If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2))
    Exit Function
  End If
  Dim i As Long
  For i = 1 To Len(Str)
    If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
      DocSo = DocSo & 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
      DocSo = DocSo & MyArray(12)
    End If
  Next
  DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
  If Number < 0 Then
    DocSo = MyArray(29) & DocSo
  End If
  DocSo = Replace(Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & "*", ",*", ""), "*", "")
End Function

Cú pháp
=DocSo(Số,1) ---> Dùng cho bảng mã Unicode
=DocSo(Số,2) ---> Dùng cho bảng mã VNI-Windows
=DocSo(Số,3) ---> Dùng cho bảng mã TCVN3
-----------------------------------------
Tôi lưu hàm này trong máy tính lâu rồi. Nhớ không lầm là của @huuthang_bd

em cảm ơn ndu96081631 nhiều nhiều ! nhân anh em cũng cảm ơn code anh huuthang_bd , code chạy đúng ý em luôn. hihi