Chuyển số thành chữ

phatnq2002 · 25/8/06

Chỉ lưu ý một điều là nếu muốn thể hiện font Unicode thì trong cửa sổ code VBA không thể gõ một cách bình thường các từ một năm sáu ... đâu đấy.

ltdung1701 · 24/1/08

Ðề: Chuyển số thành chữ

********* nói:
Mô Tả:
Bạn muốn chuyển đổi 1 số nào đó sang dạng chữ như: 12345 thành "Mười hai ngàn ba trăm bốn mươi lăm". Hãy thử đoạn code bên dưới xem.
Ví Dụ:
'Mã chuyển một số sang một chuỗi
Public Function NumToText(mVarStr As String) As String
Static Ones(0 To 11) As String, Teens(0 To 9) As String, Tens(0 To 9) As String
Static Thousands(0 To 4) As String, bInit As Boolean
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
Dim StrVal As String, StrBuff As String, StrTemp As String
Dim nCol As Integer, nChar As Integer
Dim J&
J = Len(CStr(CLng(mVarStr)))
'Chỉ làm việc cho các số dương
Debug.Assert mVarStr >= 0
If bInit = False Then
'Bắt đầu tạo mảng
bInit = True
Ones(0) = "Không"
Ones(1) = "Một"
Ones(2) = "Hai"
Ones(3) = "Ba"
Ones(4) = "Bốn"
Ones(5) = "Năm"
Ones(6) = "Sáu"
Ones(7) = "Bảy"
Ones(8) = "Tám"
Ones(9) = "Chín"
Ones(10) = "Mốt"
Ones(11) = "Tư"
Teens(0) = "Mười"
Teens(1) = "Mười Một"
Teens(2) = "Mười Hai"
Teens(3) = "Mười Ba"
Teens(4) = "Mười Bốn"
Teens(5) = "Mười Năm"
Teens(6) = "Mơừi Sáu"
Teens(7) = "Mười Bảy"
Teens(8) = "Mơừi Tám"
Teens(9) = "Mười Chín"
Tens(0) = ""
Tens(1) = "Mười"
Tens(2) = "Hai Mươi"
Tens(3) = "Ba Mươi"
Tens(4) = "Bốn Mươi"
Tens(5) = "Năm Mươi"
Tens(6) = "Sáu Mươi"
Tens(7) = "Bảy Mươi"
Tens(8) = "Tám Mươi"
Tens(9) = "Chín Mươi"
Thousands(0) = ""
Thousands(1) = "Nghìn" '
Thousands(2) = "Triệu"
Thousands(3) = "Tỉ"
Thousands(4) = "Nghìn"
End If
'Bẫy lỗi
On Error GoTo Err2TextTrap
'Lấy phần lẻ
'StrBuff = "Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100"
'Chuyển định dạng dữ liệu vào
StrVal = CStr(CLng(mVarStr))
'Tất cả cả số đều là Zero
bAllZeros = True
'Làm vòng lặp với chuỗi sau khi chuyển định dạng
For i = Len(StrVal) To 1 Step -1
'Lấy từng kí số
nChar = Val(Mid$(StrVal, i, 1))
'Tìm số cột cho kí số
nCol = (Len(StrVal) - i) + 1

'Chọn ở hàng đơn vị 1,10,100
Select Case (nCol Mod 3)
Case 1 'Trường hợp là 1
bShowThousands = True
If i = 1 Then
'Số đầu tiên
StrTemp = Ones(nChar) & " "
ElseIf Mid$(StrVal, i - 1, 1) = "1" Then
'Các số sau ở trong hàng mười
StrTemp = Teens(nChar) & " "
i = i - 1 'Giữ lại các số có hai con số
ElseIf nChar > 0 Then
'Các số có một con số
StrTemp = Ones(nChar) & " "
Else
bShowThousands = False
If Mid$(StrVal, i - 1, 1) <> "0" Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(StrVal, i - 2, 1) <> "0" Then bShowThousands = True
End If
StrTemp = ""
End If
If bShowThousands Then
If nCol > 1 Then
StrTemp = StrTemp & Thousands(nCol 3)
If bAllZeros Then
StrTemp = StrTemp & " "
Else
StrTemp = StrTemp & ", "
End If
End If
bAllZeros = False
End If
StrBuff = StrTemp & StrBuff

Case 2
If nChar > 0 Then
If Mid$(StrVal, i + 1, 1) <> "0" Then
StrBuff = Tens(nChar) & " " & StrBuff
Else
StrBuff = Tens(nChar) & " " & StrBuff
End If
End If

Case 0
If nChar > 0 Then StrBuff = Ones(nChar) & " Trăm " & StrBuff
End Select

Next i
StrBuff = Trim$(StrBuff)
If ((Right$(StrBuff, 3) = Ones(1))) And (J > 2) Then _
StrBuff = Left$(StrBuff, Len(StrBuff) - 3) & Ones(10)
If ((Right$(StrBuff, 3) = Ones(4))) And (J > 2) Then _
StrBuff = Left$(StrBuff, Len(StrBuff) - 3) & Ones(11)
' If ((Right$(StrBuff, 3) = Ones(4))) Then _
'StrTemp = Left$(StrBuff, Len(StrBuff) - 3) & Ones(11)
StrBuff = UCase$(Left$(StrBuff, 1)) & Mid$(StrBuff, 2)
'StrBuff = " Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100"
If (CDbl(mVarStr) - CLng(mVarStr) > 0) Then StrBuff = StrBuff _
& " ( Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100)"

Err2Text:
NumToText = StrBuff
Exit Function

Err2TextTrap:
StrBuff = "#Error#"
Resume Err2Text
End Function

(http://www.caulacbovb.com)

Bạn ơi!!!
Mình thử dùng macro này nhưng khi chạy thì gặp lỗi ở dòng:
"StrTemp = StrTemp & Thousands(nCol 3)"
Bạn kiểm tra lại giúp mình nhe!

Girlsmiling · 22/2/08

Ðề: Chuyển số thành chữ

Các bạn có thể vào thư viện down các add-in có sẵn về dùng. Hoặc cho mình địa chỉ mail mình sẽ gửi cho.

thanhson25 · 22/2/08

Ðề: Chuyển số thành chữ

DOwn add_in nè
http://www.mediafire.com/?38oqmzujmd1

hoaphuong_bn · 26/4/08

Ðề: Chuyển số thành chữ

********* nói:
Mô Tả:
Bạn muốn chuyển đổi 1 số nào đó sang dạng chữ như: 12345 thành "Mười hai ngàn ba trăm bốn mươi lăm". Hãy thử đoạn code bên dưới xem.
Ví Dụ:
'Mã chuyển một số sang một chuỗi
Public Function NumToText(mVarStr As String) As String
Static Ones(0 To 11) As String, Teens(0 To 9) As String, Tens(0 To 9) As String
Static Thousands(0 To 4) As String, bInit As Boolean
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
Dim StrVal As String, StrBuff As String, StrTemp As String
Dim nCol As Integer, nChar As Integer
Dim J&
J = Len(CStr(CLng(mVarStr)))
'Chỉ làm việc cho các số dương
Debug.Assert mVarStr >= 0
If bInit = False Then
'Bắt đầu tạo mảng
bInit = True
Ones(0) = "Không"
Ones(1) = "Một"
Ones(2) = "Hai"
Ones(3) = "Ba"
Ones(4) = "Bốn"
Ones(5) = "Năm"
Ones(6) = "Sáu"
Ones(7) = "Bảy"
Ones(8) = "Tám"
Ones(9) = "Chín"
Ones(10) = "Mốt"
Ones(11) = "Tư"
Teens(0) = "Mười"
Teens(1) = "Mười Một"
Teens(2) = "Mười Hai"
Teens(3) = "Mười Ba"
Teens(4) = "Mười Bốn"
Teens(5) = "Mười Năm"
Teens(6) = "Mơừi Sáu"
Teens(7) = "Mười Bảy"
Teens(8) = "Mơừi Tám"
Teens(9) = "Mười Chín"
Tens(0) = ""
Tens(1) = "Mười"
Tens(2) = "Hai Mươi"
Tens(3) = "Ba Mươi"
Tens(4) = "Bốn Mươi"
Tens(5) = "Năm Mươi"
Tens(6) = "Sáu Mươi"
Tens(7) = "Bảy Mươi"
Tens(8) = "Tám Mươi"
Tens(9) = "Chín Mươi"
Thousands(0) = ""
Thousands(1) = "Nghìn" '
Thousands(2) = "Triệu"
Thousands(3) = "Tỉ"
Thousands(4) = "Nghìn"
End If
'Bẫy lỗi
On Error GoTo Err2TextTrap
"[/COLOR] 'Chuyển định dạng dữ liệu vào
StrVal = CStr(CLng(mVarStr))
'Tất cả cả số đều là Zero
bAllZeros = True
'Làm vòng lặp với chuỗi sau khi chuyển định dạng
For i = Len(StrVal) To 1 Step -1
'Lấy từng kí số
nChar = Val(Mid$(StrVal, i, 1))
'Tìm số cột cho kí số
nCol = (Len(StrVal) - i) + 1

'Chọn ở hàng đơn vị 1,10,100
Select Case (nCol Mod 3)
Case 1 'Trường hợp là 1
bShowThousands = True
If i = 1 Then
'Số đầu tiên
StrTemp = Ones(nChar) & " "
ElseIf Mid$(StrVal, i - 1, 1) = "1" Then
'Các số sau ở trong hàng mười
StrTemp = Teens(nChar) & " "
i = i - 1 'Giữ lại các số có hai con số
ElseIf nChar > 0 Then
'Các số có một con số
StrTemp = Ones(nChar) & " "
Else
bShowThousands = False
If Mid$(StrVal, i - 1, 1) <> "0" Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(StrVal, i - 2, 1) <> "0" Then bShowThousands = True
End If
StrTemp = ""
End If
If bShowThousands Then
If nCol > 1 Then
StrTemp = StrTemp & Thousands(nCol 3)
If bAllZeros Then
StrTemp = StrTemp & " "
Else
StrTemp = StrTemp & ", "
End If
End If
bAllZeros = False
End If
StrBuff = StrTemp & StrBuff

Case 2
If nChar > 0 Then
If Mid$(StrVal, i + 1, 1) <> "0" Then
StrBuff = Tens(nChar) & " " & StrBuff
Else
StrBuff = Tens(nChar) & " " & StrBuff
End If
End If

Case 0
If nChar > 0 Then StrBuff = Ones(nChar) & " Trăm " & StrBuff
End Select

Next i
StrBuff = Trim$(StrBuff)
If ((Right$(StrBuff, 3) = Ones(1))) And (J > 2) Then _
StrBuff = Left$(StrBuff, Len(StrBuff) - 3) & Ones(10)
If ((Right$(StrBuff, 3) = Ones(4))) And (J > 2) Then _
StrBuff = Left$(StrBuff, Len(StrBuff) - 3) & Ones(11)
' If ((Right$(StrBuff, 3) = Ones(4))) Then _
'StrTemp = Left$(StrBuff, Len(StrBuff) - 3) & Ones(11)
StrBuff = UCase$(Left$(StrBuff, 1)) & Mid$(StrBuff, 2)
'StrBuff = " Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100"
If (CDbl(mVarStr) - CLng(mVarStr) > 0) Then StrBuff = StrBuff _
& " ( Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100)"

Err2Text:
NumToText = StrBuff
Exit Function

Err2TextTrap:
StrBuff = "#Error#"
Resume Err2Text
End Function

(http://www.caulacbovb.com)

Chào bạn. mình muốn hỏi bạn một chút nhé!
Mình đã từng tạo hàm này trong chương trình Excel của mình nhưng mình đang gặp một vương mắc nhỏ. Trong hàm này có phần qui đổi phần lẻ(số sau dấu phẩy), nhưng trong kế toán mình phải làm tròn đến đơn vị đồng,nêu dùng hàm có đoạn code như trên thì khi mình dùng hàm lấy địa chỉ ở ô TỔNG CỘNG thì nó ra chữ gồm cả phần lẻ(ô tổng cộng của mình không được để số thập phân) :sweatdrop:

vậy mình phải sửa đoạn code trên như thế nào?
Giúp mình với nhé!
Thanks

phatnq2002 · 28/4/08

Ðề: Chuyển số thành chữ

Bạn hoaphuong_bn có thể chỉnh lại tí xíu như sau:
Do hàm nhân param là String nên tôi nghĩ bạn nên tuỳ biến một chút, là đổi param nó là một kiểu số.
Theo cách viết của hàm mà bạn kèm theo thì ở đây chỉ cho phép độ dài số tối đa là 12, do vậy bạn sẽ hiệu chỉnh như sau:

Public Function NumToText(mVar) As String
Dim mVarStr As String
mVarStr = Str(mVar)
If InStr(mVarStr, ".") <> 0 Then
mVarStr = Left(mVarStr, InStr(mVarStr, ".") - 1)
End If

Các câu sau để nguyên.

hocketoan

New Member

phatnq2002

Tích cực giảm cân...

ltdung1701

New Member

Girlsmiling

Lạnh lùng

thanhson25

Kẻ vô hình-Superwind

hoaphuong_bn

New Member

phatnq2002

Tích cực giảm cân...

Chuyển số thành chữ

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

KÊNH YOUTUBE DKT

SÁCH QUYẾT TOÁN THUẾ