Lên mạng tìm cũng thấy nhưng mang về edit nói cứ báo lỗi. Một số trang thì cứ đòi làm thành viên mới cho down. Xin chân thành cảm ơn!
Quang Sy
Hồi âm xin gửi về: vitinh@vnexpress.net
Hồi âm:
Mình tình cờ có được 1 mẫu file Excel của khách hàng làm phiếu thu và phiếu chi có phần chuyển số tiền thành chữ! Theo mình biết thì mỗi con số có 1 hàm riêng ví dụ 500.000 đồng sẽ gồm 7 lệnh trong đó 6 lệnh chuyển mỗi ký tự thành chữ và có 1 hàm nữa kết hợp tất cả các chữ số đó lại thành “năm trăm ngàn đồng chẵn”. Hãy e-mail theo địa chỉ: hongbaongan@gmail.com, mình sẽ gửi cho bạn!
Hong Bao Ngan
Chào bạn, tặng bạn chương trình dịch số để sử dụng. Chúc bạn thành công.
Function DLT(sotien)
If sotien = 0 Then
ketqua = "Khoâng ñoàng"
Else
If Abs(sotien) > 999999999999.99 Then
ketqua = "Soá quaù lôùn"
Else
If sotien < 0 Then
ketqua = "Tröø"
Else
ketqua = Space(0)
End If
B = Space(1)
tien = Format(Abs(sotien), "###########0.00")
tien = Right(Space(12) + tien, 15)
chudoc = Space(0)
chudoc = chudoc + "traêm möôi tyû traêm möôi trieäu traêm möôi ngaøn traêm möôi ñoàng traêm möôi xu"
chuso = Space(0)
chuso = chuso + "moät hai ba boán naêm saùu baûy taùm chín "
For i = 1 To 5
baso = Mid(tien, i * 3 - 2, 3)
If baso <> Space(3) Then
Select Case baso
Case "000"
If i = 4 Then
chu = "ñoàng"
Else
chu = Space(0)
End If
Case ".00"
chu = " chaün"
Case Else
so1 = Left(baso, 1)
so2 = Mid(baso, 2, 1)
so3 = Right(baso, 1)
chu = Space(0)
For j = 1 To 3
dich = Space(0)
s = Val(Mid(baso, j, 1))
If s > 0 Then
'------------------------
dich = Trim(Mid(chuso, s * 5 - 4, 5)) + B + Trim(Mid(chudoc, (i - 1) * 18 + j * 6 - 5, 6)) + Space(1)
End If
Select Case j
Case Is = 2 And s = 1
dich = "möôøi" + Space(1)
Case Is = 3 And s = 0 And baso <> Space(2) + "0"
dich = Trim(Mid(chudoc, (i - 1) * 18 + j * 6 - 5, 6)) + Space(1)
Case Is = 3 And s = 5 And so2 <> Space(1) And so2 <> "0"
dich = "l" + Mid(dich, 2)
Case 2 And s = 0 And so3 <> "0"
If (so1 >= "1" And so1 <= "9") Or (so1 = "0" And i = 4) Then
dich = "leû" + Space(1)
End If
End Select
chu = chu + dich
Next j
End Select
vitri = InStr(1, chu, "möôi moät", 1)
If vitri > 0 Then
chu = Mid(chu, vitri, 9)
End If
ketqua = ketqua + chu
End If
Next i
End If
End If
DLT = UCase(Left(ketqua, 1)) + Mid(ketqua, 2)
End Function
Do Lenh Tien
Do VBA không hỗ trợ Unicode trực tiếp nên phải dùng gián tiếp. Nhớ enable macro. Có thể nhấn Alt+F11 để xem code
Private wordsArr(9, 3) As String
Private Sub WordInitialize()
'Cach dem so
wordsArr(0, 0) = "m" & ChrW(7897) & "t": wordsArr(1, 0) = "hai": wordsArr(2, 0) = "ba"
wordsArr(3, 0) = "b" & ChrW(7889) & "n": wordsArr(4, 0) = "n" & ChrW(259) & "m": wordsArr(5, 0) = "s" & ChrW(225) & "u"
wordsArr(6, 0) = "b" & ChrW(7843) & "y": wordsArr(7, 0) = "t" & ChrW(225) & "m": wordsArr(8, 0) = "ch" & ChrW(237) & "n"
wordsArr(9, 0) = "m" & ChrW(432) & ChrW(7901) & "i"
wordsArr(0, 1) = "tr" & ChrW(259) & "m": wordsArr(1, 1) = "ch" & ChrW(7909) & "c": wordsArr(2, 1) = "hai m" & ChrW(432) & ChrW(417) & "i"
wordsArr(3, 1) = "ba m" & ChrW(432) & ChrW(417) & "i": wordsArr(4, 1) = "b" & ChrW(7889) & "n m" & ChrW(432) & ChrW(417) & "i": wordsArr(5, 1) = "n" & ChrW(259) & "m m" & ChrW(432) & ChrW(417) & "i"
wordsArr(6, 1) = "s" & ChrW(225) & "u m" & ChrW(432) & ChrW(417) & "i": wordsArr(7, 1) = "b" & ChrW(7843) & "y m" & ChrW(432) & ChrW(417) & "i": wordsArr(8, 1) = "t" & ChrW(225) & "m m" & ChrW(432) & ChrW(417) & "i"
wordsArr(9, 1) = "ch" & ChrW(237) & "n m" & ChrW(432) & ChrW(417) & "i"
wordsArr(0, 3) = "m" & ChrW(432) & ChrW(7901) & "i": wordsArr(1, 3) = "m" & ChrW(432) & ChrW(7901) & "i m" & ChrW(7897) & "t": wordsArr(2, 3) = "m" & ChrW(432) & ChrW(7901) & "i hai"
wordsArr(3, 3) = "m" & ChrW(432) & ChrW(7901) & "i ba": wordsArr(4, 3) = "m" & ChrW(432) & ChrW(7901) & "i b" & ChrW(7889) & "n": wordsArr(5, 3) = "m" & ChrW(432) & ChrW(7901) & "i l" & ChrW(259) & "m"
wordsArr(6, 3) = "m" & ChrW(432) & ChrW(7901) & "i s" & ChrW(225) & "u": wordsArr(7, 3) = "m" & ChrW(432) & ChrW(7901) & "i b" & ChrW(7843) & "y": wordsArr(8, 3) = "m" & ChrW(432) & ChrW(7901) & "i t" & ChrW(225) & "m"
wordsArr(9, 3) = "m" & ChrW(432) & ChrW(7901) & "i ch" & ChrW(237) & "n"
End Sub
Public Function ToWords(NumberStr As String) As String
Call WordInitialize
Dim z As String, x As String, Temp As String, c As String, d As String
Dim a As Integer, b As Integer, i As Integer
'remove redundant spaces
NumberStr = Trim(NumberStr)
a = Len(NumberStr)
Temp = NumberStr
If Val(NumberStr) = 0 Then
ToWords = "zero!"
Exit Function
End If
While ((a Mod 3) <> 0)
Temp = "0" & Temp
a = Len(Temp)
Wend
NumberStr = Temp
For i = a - 2 To 1 Step -3
b = b + 1
Temp = Mid(NumberStr, i, 3)
z = ""
' "Intelligent" routines
'------------------------
'Hang tram
If Temp <> "000" Then
c = Left(Temp, 1)
If c <> "0" Then
z = " " & wordsArr(Val(c) - 1, 0) & " tr" & ChrW(259) & "m"
Else
If (b = 1) And (a > 3) Then z = " " & " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
End If
'Hang chuc
c = Mid(Temp, 2, 1)
d = Right(Temp, 1)
If c <> "0" Then
If c <> "1" Then
z = z & " " & wordsArr(Val(c), 1)
Else
z = z & " " & wordsArr(Val(Right(Temp, 2)) - 10, 3)
End If
Else
If b >= 1 And d <> "0" Then z = z & " l" & ChrW(7867)
End If
If d <> "0" And Mid(Temp, 2, 1) <> "1" Then
If c <> 0 Then
Select Case d
Case 1
z = z & " m" & ChrW(7897) & "t"
Case 4
z = z & " t" & ChrW(432) & ""
Case 5
z = z & " l" & ChrW(259) & "m"
Case Else
z = z & " " & wordsArr(Val(Right(Temp, 1)) - 1, 0)
End Select
Else
z = z & " " & wordsArr(Val(Right(Temp, 1)) - 1, 0)
End If
End If
End If
'------------------------
If z <> "" Then
Select Case b
Case 1:
x = z
Case 2:
x = z & " ng" & ChrW(224) & "n" & x
Case 3:
x = z & " tri" & ChrW(7879) & "u" & x
Case 4:
x = z & " t" & ChrW(7927) & x
Case 5:
x = z & "NA" & x
Case Else:
Exit Function
'you can easily add more range
'like Case 6: can be "zillion"? :) (whatever)
End Select
End If
Next
x = Trim(x)
If Left(x, 1) = "l" Then x = Right(x, Len(x) - 3)
'x = UCase(Left(x, 1)) & Right(x, Len(x) - 1)
ToWords = UCase(Left(x, 1))
ToWords = ToWords & Right(x, Len(x) - 1)
End Function
Vo Dai Ngoc
Hàm đổi số thành chữ =text (khong can doi dinh dang) trong đó: ô cần đổi là ô chứa giá trị số định dạng: là dạng số cần thể hiện ra VD: ô cần đổi chứa giá trị số là: 12345 nếu muốn đổi sang gíá trị text thì có thể sử dụng định dạng: #### hoặc ####,### hoặc dd/mm/yyyy nếu sử dụng định dạng ##### thì giá trị text nhận đuợc là :12345 không tin thì sử dụng hàm istext xem có phải giá trị đó là text hay không.
Le Manh Hung
Như ta đã biết trong các giấy tờ kế toán thường ghi bằng số và bằng chữ.
Đây là hàm giúp bạn thực hiện việc này dễ dàng với các bảng mã VNI, ABC, Unicode. Để tiện cho mọi người sử dụng tôi xin giới thiệu sơ qua cách sử dụng hàm trong Excel:
Bước 1: Mở trình soạn thảo VBA
- Vào Tools>Macro>Visual Basic Editor
=> Thêm 1 module
- Vào Insert>Module
=> Trong module1
Copy code dưới đây vào module1:
Bước 2: Quay lại sheet trong Excel:
- Nhập A1= 123.456.789.105,00
- A2= NumberToText(A1)
= Một trăm hai mươi ba tỷ, bốn trăm năm mươi sáu triệu, bảy trăm tám mươi chín nghìn, một trăm lẻ năm
*Ghi chú:
A2 = NumberToText(A1,0) 'Hàm định dạng Font Windows-VNI (Vni-Times)
A2=NumberToText(A1,1) 'Hàm định dạng Font ABC (VNTimes)
A2=NumberToText(A1,2) 'Hàm định dạng Font Unicode (Tahoma)
Nếu bạn nào muốn chỉnh sửa theo nhu cầu xin Email:
phvthanh@gmail.com mình sẽ chỉnh sửa lại.
Sau đây là đoạn CODE:
Public Enum Font_Codes
Font_VNI = 0
Font_ABC = 1
Font_Unicode = 2
End Enum
Public Function NumberToText(ByVal varVal As Variant, Optional ByVal Code As Font_Codes) As String
On Error GoTo Pro_Err
Static sDVs(0 To 15) As String
Static sDVNs(0 To 9) As String
Dim strErr As String
Dim sTens As String
Dim sHundred As String
Dim strDong As String
Dim strDolla As String
Dim sVal As String
Dim iVal As Integer
Dim i As Integer
Dim iCol As Integer
Dim iChar As Integer
Dim sTemp As String
Dim iScan As Integer
Dim strCurrency As String
Select Case Code
Case 0
sDVs(0) = " khoâng"
sDVs(1) = " moät"
sDVs(2) = " hai"
sDVs(3) = " ba"
sDVs(4) = " boán"
sDVs(5) = " naêm"
sDVs(6) = " saùu"
sDVs(7) = " baûy"
sDVs(8) = " taùm"
sDVs(9) = " chín"
sDVs(10) = " möôøi"
sDVs(11) = " moát"
sDVs(12) = " leû"
sDVs(13) = ""
sDVs(14) = " tö"
sDVs(15) = " laêm"
sDVNs(0) = ""
sDVNs(1) = " nghìn,"
sDVNs(2) = " trieäu,"
sDVNs(3) = " tyû,"
sDVNs(4) = " nghìn tyû,"
sDVNs(5) = " trieäu tyû,"
sDVNs(6) = " tyû tyû,"
sDVNs(7) = " nghìn tyû tyû,"
sDVNs(8) = " trieäu tyû tyû,"
sDVNs(9) = " tyû tyû tyû,"
strErr = " Loãi nhaäp!"
strEven = " chaün"
sHundred = " traêm"
sTens = " möôi"
strDong = " ñoàng"
strDolla = " ñoâ la"
Case 1
sDVs(0) = " kh«ng"
sDVs(1) = " mét"
sDVs(2) = " hai"
sDVs(3) = " ba"
sDVs(4) = " bèn"
sDVs(5) = " n¨m"
sDVs(6) = " s¸u"
sDVs(7) = " b¶y"
sDVs(8) = " t¸m"
sDVs(9) = " chÝn"
sDVs(10) = " mêi"
sDVs(11) = " mèt"
sDVs(12) = " lÎ"
sDVs(13) = ""
sDVs(14) = " t"
sDVs(15) = " l¨m"
sDVNs(0) = ""
sDVNs(1) = " ngh×n,"
sDVNs(2) = " triÖu,"
sDVNs(3) = " tû,"
sDVNs(4) = " ngh×n tû,"
sDVNs(5) = " triÖu tû,"
sDVNs(6) = " tû tû,"
sDVNs(7) = " ngh×n tû tû,"
sDVNs(8) = " triÖu tû tû,"
sDVNs(9) = " tû tû tû,"
strErr = " Lçi nhËp!"
strEven = " ch½n"
sHundred = " tr¨m"
sTens = " m¬i"
strDong = " ®ång"
strDolla = " ®« la"
Case 2
sDVs(0) = " kh" & ChrW$(&HF4) & "ng"
sDVs(1) = " m" & ChrW$(&H1ED9) & "t"
sDVs(2) = " hai"
sDVs(3) = " ba"
sDVs(4) = " b" & ChrW$(&H1ED1) & "n"
sDVs(5) = " n" & ChrW$(&H103) & "m"
sDVs(6) = " s" & ChrW$(&HE1) & "u"
sDVs(7) = " b" & ChrW$(&H1EA3) & "y"
sDVs(8) = " t" & ChrW$(&HE1) & "m"
sDVs(9) = " ch" & ChrW$(&HED) & "n"
sDVs(10) = " m" & ChrW$(&H1B0) & ChrW$(&H1EDD) & "i"
sDVs(11) = " m" & ChrW$(&H1ED1) & "t"
sDVs(12) = " l" & ChrW$(&H1EBB)
sDVs(13) = ""
sDVs(14) = " t" & ChrW$(&H1B0)
sDVs(15) = " l" & ChrW$(&H103) & "m"
sDVNs(0) = ""
sDVNs(1) = " ngh" & ChrW$(&HEC) & "n,"
sDVNs(2) = " tri" & ChrW$(&H1EC7) & "u,"
sDVNs(3) = " t" & ChrW$(&H1EF7) & ","
sDVNs(4) = " ngh" & ChrW$(&HEC) & "n" & " t" & ChrW$(&H1EF7) & ","
sDVNs(5) = " tri" & ChrW$(&H1EC7) & "u" & " t" & ChrW$(&H1EF7) & ","
sDVNs(6) = " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
sDVNs(7) = " ngh" & ChrW$(&HEC) & "n" & " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
sDVNs(8) = " tri" & ChrW$(&H1EC7) & "u" & " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
sDVNs(9) = " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & " t" & ChrW$(&H1EF7) & ","
strErr = " L" & ChrW$(&H1ED7) & "i" & " nh" & ChrW$(&H1EAD) & "p!"
strEven = " ch" & ChrW$(&H1EB5) & "n"
sHundred = " tr" & ChrW$(&H103) & "m"
sTens = " m" & ChrW$(&H1B0) & ChrW$(&H1A1) & "i"
strDong = " " & ChrW$(&H111) & ChrW$(&H1ED3) & "ng"
strDolla = " " & ChrW$(&H111) & ChrW$(&HF4) & " la"
End Select
For iScan = 1 To Len(varVal)
If IsNumeric(Mid$(varVal, iScan, 1)) Then
sVal = sVal & Mid$(varVal, iScan, 1)
ElseIf Mid$(varVal, iScan, 1) = "$" Or UCase(Mid$(varVal, iScan, 3)) = "USA" Then
strCurrency = strDolla
ElseIf LCase(Mid$(varVal, iScan, Len("ñ"))) = "ñ" Or _
LCase(Mid$(varVal, iScan, Len("d"))) = "d" Or _
LCase(Mid$(varVal, iScan, Len("vnd"))) = "vnd" Or _
LCase(Mid$(varVal, iScan, 1)) = ChrW$(&H111) Or _
LCase(Mid$(varVal, iScan, Len("®"))) = "®" Then
strCurrency = strDong
End If
Next iScan
iVal = Len(sVal)
If iVal > 0 And iVal < 15 Then
sTemp = strCurrency
For i = iVal To 1 Step -1
iChar = Val(Mid$(sVal, i, 1))
iCol = iVal - (i - 1)
Select Case (iCol Mod 3)
Case 1
If iChar = 0 And iVal > 1 Then
If iVal = iCol + 1 Then
If Mid$(sVal, i - 1, 1) <> "0" Then
sTemp = sDVNs(iCol \ 3) & sTemp
End If
ElseIf iVal > iCol + 1 Then
If Val(Mid$(sVal, i - 2, 2)) > 0 Then
sTemp = sDVNs(iCol \ 3) & sTemp
End If
Else
sTemp = sTemp
End If
Else
If iChar = 1 And iVal > iCol Then
If Val(Mid$(sVal, i - 1, 1)) > 1 Then
iChar = 11
End If
ElseIf iChar = 4 And iVal > iCol Then
If Val(Mid$(sVal, i - 1, 1)) > 1 Then
iChar = 14
End If
ElseIf iChar = 5 And iVal > iCol Then
If Val(Mid$(sVal, i - 1, 1)) > 0 Then
iChar = 15
End If
End If
sTemp = sDVs(iChar) & sDVNs(iCol \ 3) & sTemp
End If
Case 2
If iChar > 1 Then
sTemp = sDVs(iChar) & sTens & sTemp
Else
If iChar = 1 Then
iChar = 10
ElseIf iChar = 0 And (Mid$(sVal, i + 1, 1) <> "0") Then
iChar = 12
Else
iChar = 13
End If
sTemp = sDVs(iChar) & sTemp
End If
Case 0
If iChar = 0 And ((Mid$(sVal, i + 1, 1) = "0") And (Mid$(sVal, i + 2, 1) = "0")) Then
sTemp = sTemp
Else
sTemp = sDVs(iChar) & sHundred & sTemp
End If
End Select
Next i
ElseIf iVal = 0 Then
sTemp = ""
End If
sTemp = Trim(sTemp)
If Right$(sTemp, 1) = "," Then
sTemp = Mid$(sTemp, 1, Len(sTemp) - 1)
End If
NumberToText = UCase$(Left$(sTemp, 1)) & Mid$(sTemp, 2)
Pro_Next:
Exit Function
Pro_Err:
GoTo Pro_Next
End Function
Ngọc Thanh