Cách đổi số ra chữ trong Excel

dhthanh8x

Member
Hội viên mới
Để tạo 1 đoạn mã Macro chuyển đổi số ra chữ trong 1 file Excel bạn làm các bước sau:
1. Mở và Save tên tập tin Excel mới
2. Đoạn mã Macro luôn chạy ở mức "Security trung bình or thấp": chọn Tools-->Macro-->Security-->chọn Medium hoặc Low
3. Vào chương trình Visual Basic: chọn Tools-->Macro-->Security-->Visual Basic Editor--> Hiện cửa sổ Microsoft Visual Basic
4. Trong cửa sổ Microsoft Visual Basic: chọn Insert --> Module--> xuất hiện khoảng trắng bên phải --> bạn "Copy" đoạn mã Macro màu xanh dưới đây vào khoảng trắng này

Function DocSoVni(conso) As String
s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
lop3 = Array("", " trieäu", " nghìn", " tyû")
If Trim(conso) = "" Then
DocSoVni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = "aâm " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tyû" Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
Else
s1 = s09(n1) & " traê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öôøi" Else s2 = s09(n2) & " möôi"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " laêm"
Else
s3 = s09(n3)
End If
If i > Len(conso) 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(conso) Then Exit Do
Loop
If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
Else
DocSoVni = conso
End If
End Function
Function DocSoUni(conso) 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(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - 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(conso) 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(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
End Function

5. Save và turn off cửa sổ Microsoft Visual Basic
6. Tại cửa sổ Microsoft Excel ta sẽ test như sau:
- Địa chỉ A1 gõ: 123.456.789
- Địa chỉ A2 gõ: =DocSoUni(A1) hoặc =DocSoVni(A1)
*Do đơn vị tiền tệ có thể là VNĐ, YEN, USD, EURO...nên kết hợp thêm lệnh xử lý text...bạn gõ lại như sau:
=DocSoUni(A1)&" VNĐ" hoặc =DocSoVni(A1)&" USD" (nhớ thêm khoảng cách trong dấu "")

**Chú thích:
- Trong đoạn mã Macro có 2 dòng màu xanh dương in đậm là DocSoVni DocSoUni... đây là câu lệnh để đọc số theo dạng font Unicode hoặc Vni-Times...ai dùng font nào thì dùng câu lệnh đó
- Nên thực hiện trên Office 2003 vì có thể thao tác dễ dàng trên Visual Basic...
Chúc bạn thành công!!!:ammuu:
 
Sửa lần cuối bởi điều hành viên:
Re: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Cảm ơn dhthanh8x nha
Mình làm đc rồi nhưng chữ đầu tiên trong thành tiền không viết hoa đc thôi và tới phân cách hàng triệu, nghìn hay hàng trăm không có dấu phẩy
bạn có cách nào giúp minh không?
Cảm ơn bạn lần nửa nha
Chúc nhà mình luôn đoàn kết
 
Ðề: Re: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Cảm ơn dhthanh8x nha
Mình làm đc rồi nhưng chữ đầu tiên trong thành tiền không viết hoa đc thôi và tới phân cách hàng triệu, nghìn hay hàng trăm không có dấu phẩy
bạn có cách nào giúp minh không?
Cảm ơn bạn lần nửa nha
Chúc nhà mình luôn đoàn kết

Chữ viết hoa đầu dòng thì quá giới hạn của minh....nhờ cao thủ IT xin chỉ dùm thêm đoạn mã:roile:
Còn dấu phân cách thì trong luật kế toán không quy định nên bạn không nên quan trong hóa nó...cách viết này "cổ" rồi:k4232942:
Clich cảm ơn là ok:xinloinhe:
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Cái này rắc rối quá, mình có vnTools, chỉ cần addin vào excel trên thanh công cụ (Toolbars) sẽ hiển thị vntools: đổi số thành chữ chỉ bằng 1 click, có đơn vị VNĐ và USD :dangiuqua:
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Để tạo 1 đoạn mã Macro chuyển đổi số ra chữ trong 1 file Excel bạn làm các bước sau:
1. Mở và Save tên tập tin Excel mới
2. Đoạn mã Macro luôn chạy ở mức "Security trung bình or thấp": chọn Tools-->Macro-->Security-->chọn Medium hoặc Low
3. Vào chương trình Visual Basic: chọn Tools-->Macro-->Security-->Visual Basic Editor--> Hiện cửa sổ Microsoft Visual Basic
4. Trong cửa sổ Microsoft Visual Basic: chọn Insert --> Module--> xuất hiện khoảng trắng bên phải --> bạn "Copy" đoạn mã Macro màu xanh dưới đây vào khoảng trắng này

Function DocSoVni(conso) As String
s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
lop3 = Array("", " trieäu", " nghìn", " tyû")
If Trim(conso) = "" Then
DocSoVni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = "aâm " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tyû" Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
Else
s1 = s09(n1) & " traê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öôøi" Else s2 = s09(n2) & " möôi"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " laêm"
Else
s3 = s09(n3)
End If
If i > Len(conso) 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(conso) Then Exit Do
Loop
If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
Else
DocSoVni = conso
End If
End Function
Function DocSoUni(conso) 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(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - 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(conso) 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(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
End Function

5. Save và turn off cửa sổ Microsoft Visual Basic
6. Tại cửa sổ Microsoft Excel ta sẽ test như sau:
- Địa chỉ A1 gõ: 123.456.789
- Địa chỉ A2 gõ: =DocSoUni(A1) hoặc =DocSoVni(A1)
*Do đơn vị tiền tệ có thể là VNĐ, YEN, USD, EURO...nên kết hợp thêm lệnh xử lý text...bạn gõ lại như sau:
=DocSoUni(A1)&" VNĐ" hoặc =DocSoVni(A1)&" USD" (nhớ thêm khoảng cách trong dấu "")

**Chú thích:
- Trong đoạn mã Macro có 2 dòng màu xanh dương in đậm là DocSoVni DocSoUni... đây là câu lệnh để đọc số theo dạng font Unicode hoặc Vni-Times...ai dùng font nào thì dùng câu lệnh đó
- Nên thực hiện trên Office 2003 vì có thể thao tác dễ dàng trên Visual Basic...
Chúc bạn thành công!!!:ammuu:
Cảm ơn bạn nhiều nha
m làm đk rùi
hjhj
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

cái này phức tạp quá
tớ có cái add đọc số thành chữ muốn thì cho tớ cái mail tớ gửi cho, cài nhanh chỉ mấy thao tác là ok
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Bạn nào có cách khác đơn giản hơn không,thấy cách này phức tạp quá.Có thể cho mình xin công thức và cách làm đc ko? mail của mình giapch@gmail.com
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

bạn gửi cho m với mail của m là thuyhangctk@gmail
t làm về mảng công nợ cũng cần cái này.hjhj.cảm ơn nha
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Lên mạng tải vntools về và cài đặt nó lên, mở excel lên vào tools chọn add ins và duyệt đến thư mục cài đặt chứa vntools (c:-/programs files\vntools) ->ok.
và ô cần chuyển gõ dòng lệnh: vnd(A2,true) với a2 là ô chứa số cần chuyển. chúc thành công
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Bạn thanh gửi cho mình với nhé
MÌnh đọc chẳng hiểu gì cả
Thanhk you bạn nhé
Mail:anhdaokt90@gmail.com
 
Ðề: CÁCH ĐỔI SỐ RA CHỮ TRONG EXCEL

Tôi có Addin cho các bạn đây, các bạn làm theo hưỡng dẫn dưới đây đảm bảo thành công 100%
B1.Đầu tiên bạn Download Addin này về: Tien Hung.xla
B2. Mở Excel
B3. Bạn vào TOOL ==> ADDIN ==> BROWSE... ==> Chọn đường dẫn tới Addin mà bạn vừa Download về
B4. Khi nào cần dùng bạn chỉ cần dùng công thức =bocapden(địa chi ô cần đọc) rồi Enter là nó tự đổi ra chữ cho các bạn.
Ghi chú: Đây là Font Vntime các bạn nhé.
 

CẨM NANG KẾ TOÁN TRƯỞNG


Liên hệ: 090.6969.247

KÊNH YOUTUBE DKT

Kỹ thuật giải trình thanh tra BHXH

Đăng ký kênh nhé cả nhà

SÁCH QUYẾT TOÁN THUẾ


Liên hệ: 090.6969.247

Top