Mạng xã hội Tamtay.vn

Niềm vui trong tầm tay

nguyennhh

nguyennhh

Danh hiệu Blogger

Bài viết 36

Được dõi theo 0

Tạo hàm mới Chuyển đổi Số thành Chữ trong Excel

23/08/2007| 9970 Xem| 6 Bình luận| 0 Thích
104 magnify
Trong công tác kế toán việc ứng dụng Excel là hết sức cần thiết tuy nhiên để tăng tiện ích trong công việc chúng ta cần sử dụng một số thủ thuật như tạo hàm người dùng chuyển số thành chữ. Tôi sẽ giới thiệu với các bạn bộ code trong ứng dụng VBA:


1. Hàm chuyển số thành chữ:

Public Function Docso(number)
' By Hoang Nguyen
' Dich tu so ra thanh tien voi phong chu .VN

' Kiem tra truong hop dac biet voi so 0 va 1
If number = 0 Then
Dich = "Kh«ng."
ElseIf number = 1 Then
Dich = "Mét."
Else
' Neu khong phai 2 truong hop tren thi tiep tuc lam
so = Array("kh«ng", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chÝn") 'mang so
DV = Array(".", "ngh×n", "triÖu", "tû", "ngh×n") 'mang don vi
SL = Len(Round(number, 0)) 'So luong ky tu trong chuoi da loai cac chu so thap phan
cap = Round(SL / 3 + 0.2, 0) 'Tinh xem chuoi nam trong pham vi mang don vi nao
Thua = SL Mod 3 'So ky tu cua mang don vi lon nhat
' Vong lap mang don vi
For i = 1 To cap
'Tinh so ky tu cua mang dang xet, Kiem tra xem co phai mang lon nhat khong
If i = cap And Thua <> 0 Then
b = Thua
Else
b = 3
End If
'Loc lay mang don vi can doc
ai = Left(Right(Round(number, 0), i * 3), b)
SLi = Len(ai)
'Kiem tra truong hop dac biet mang don vi dang xet bang khong het
If ai = "000" Then
If i = 1 Then
Dich = "."
Else
Dich = Dich
End If

Else
'Vong lap doc ky tu trong mang dang xet
For j = 1 To b
Hang = Array(DV(i - 1), "m­¬i", "tr¨m") 'Mang don vi tinh cua ky tu
Docso = Mid(ai, (b + 1 - j), 1) 'Loc lay ky tu can doc
'Kiem tra truong hop dac biet ky tu bang khong
If Docso = 0 Then
If j = 1 Then
Doc = "" & Hang(j - 1)
danhdau1 = 1 'Thong bao ky tu don vi cua mang doc bang khong
ElseIf j = 2 Then
If danhdau1 = 1 Then
Doc = ""
danhdau2 = 1 'Thong bao 2 ky tu dau tien cua mang den bang khong
Else
Doc = "linh" 'Truong hop dac biet khi chu so hang chuc bang khong
End If
Else
If danhdau2 = 1 Then
Doc = "" 'Truong hop dac biet khi ca 3 chu so trong mang deu bang khong
Else
Doc = so(Docso) & " " & Hang(j - 1)
End If
End If
ElseIf Docso = 1 And j = 2 Then
Doc = "m­êi" 'Tr­¬ng hop dac biet khi ky tu hang chuc cua mang bang mot
ElseIf Docso = 5 And j = 1 And b <> 1 Then
Doc = "l¨m" & " " & Hang(j - 1) 'Truong hop dac biet khi ky tu hang don vi cua mang bang 5
ElseIf Docso = 4 And j = 1 And SL <> 1 Then
Doc = "t­" & " " & Hang(j - 1) 'Truong hop dac biet khi ky tu hang don vi cua mang bang 4
Else
Doc = so(Docso) & " " & Hang(j - 1)
End If
Dich = Doc & " " & Dich 'Ket hop cac so da doc
Next
'Dua cac danh dau ve gia tri ban dau
danhdau1 = 0
danhdau2 = 0
End If
Next

End If

Docso = UCase(Left(Dich, 1)) & Mid(Dich, 2) 'Dua ra ket qua va sua ky tu dau tien thanh viet hoa.

End Function


2. Hàm đọc số tiền:

Public Function Doctien(sotien)
' By Hoang Nguyen
' Dich tu so ra thanh tien voi phong chu .VN

' Kiem tra truong hop dac biet voi so 0 va 1
If sotien = 0 Then
Dich = "Kh«ng ®ång."
ElseIf sotien = 1 Then
Dich = "Mét ®ång."
Else
' Neu khong phai 2 truong hop tren thi tiep tuc lam
so = Array("kh«ng", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "b¶y", "t¸m", "chÝn") 'mang so
DV = Array("®ång.", "ngh×n", "triÖu", "tû", "ngh×n") 'mang don vi
SL = Len(Round(sotien, 0)) 'So luong ky tu trong chuoi da loai cac chu so thap phan
cap = Round(SL / 3 + 0.2, 0) 'Tinh xem chuoi nam trong pham vi mang don vi nao
Thua = SL Mod 3 'So ky tu cua mang don vi lon nhat
' Vong lap mang don vi
For i = 1 To cap
'Tinh so ky tu cua mang dang xet, Kiem tra xem co phai mang lon nhat khong
If i = cap And Thua <> 0 Then
b = Thua
Else
b = 3
End If
'Loc lay mang don vi can doc
ai = Left(Right(Round(sotien, 0), i * 3), b)
SLi = Len(ai)
'Kiem tra truong hop dac biet mang don vi dang xet bang khong het
If ai = "000" Then
If i = 1 Then
Dich = "®ång."
Else
Dich = Dich
End If

Else
'Vong lap doc ky tu trong mang dang xet
For j = 1 To b
Hang = Array(DV(i - 1), "m­¬i", "tr¨m") 'Mang don vi tinh cua ky tu
Docso1 = Mid(ai, (b + 1 - j), 1) 'Loc lay ky tu can doc
'Kiem tra truong hop dac biet ky tu bang khong
If Docso1 = 0 Then
If j = 1 Then
Doc = "" & Hang(j - 1)
danhdau1 = 1 'Thong bao ky tu don vi cua mang doc bang khong
ElseIf j = 2 Then
If danhdau1 = 1 Then
Doc = ""
danhdau2 = 1 'Thong bao 2 ky tu dau tien cua mang den bang khong
Else
Doc = "linh" 'Truong hop dac biet khi chu so hang chuc bang khong
End If
Else
If danhdau2 = 1 Then
Doc = "" 'Truong hop dac biet khi ca 3 chu so trong mang deu bang khong
Else
Doc = so(Docso1) & " " & Hang(j - 1)
End If
End If
ElseIf Docso1 = 1 And j = 2 Then
Doc = "m­êi" 'Tr­¬ng hop dac biet khi ky tu hang chuc cua mang bang mot
ElseIf Docso1 = 5 And j = 1 And b <> 1 Then
Doc = "l¨m" & " " & Hang(j - 1) 'Truong hop dac biet khi ky tu hang don vi cua mang bang 5
ElseIf Docso1 = 4 And j = 1 And SL <> 1 Then
Doc = "t­" & " " & Hang(j - 1) 'Truong hop dac biet khi ky tu hang don vi cua mang bang 4
Else
Doc = so(Docso1) & " " & Hang(j - 1)
End If
Dich = Doc & " " & Dich 'Ket hop cac so da doc
Next
'Dua cac danh dau ve gia tri ban dau
danhdau1 = 0
danhdau2 = 0
End If
Next

End If

Doctien = UCase(Left(Dich, 1)) & Mid(Dich, 2) 'Dua ra ket qua va sua ky tu dau tien thanh viet hoa.

End Function

Để tạo được hàm người dùng các bạn làm như sau:
Mở một file Excel mới vào Tools, Macro , Visual Basic Editor. Ở đây sẽ xuất hiện giao diện VBA các bạn chọn Insert, Module rồi copy 2 đoạn mã trên vào cửa sổ Module mới mở. Chọn Save as dưới dạng Add-in (có dạng *.xla).
Copy file xla vừa làm rồi mở một file Excel mới vào Tools, Add-in, trong hộp thoại Add-in chọn Browse, paste file xla vào cửa sổ Add-in vừa được mở ra, OK. Chở lại hộp thoại Add-in bấm chọn vào dòng Đổi số ra chữ, OK.
Thế là bạn đã có thể sử dụng 2 hàm docso() và doctien() giống như các hàm excel khác.

Các bạn lưu ý: font chữ đang dùng cho hàm này là hệ TCVN, các bạn format các cell có chứa hàm này về hệ font này nhé! (".vntime", ".vnarial"...)

Chúc các bạn thành công.

Cùng chuyên mục

Bình luận (6)

Bạn phải đăng nhập để viết bình luận cho bài viết này
back to top