Tự tạo hàm trong excel

Hình 1
BẢN TIN KHOA HỌC, CAO ĐẲNG THƯƠNG MẠI - SỐ 03 (Q.II/2008)
TỰ TẠO HÀM TRONG EXCEL 97/2003
Ths. Trần Kiêm Hồng
Đặt vấn đề: Trong Excel do yêu cầu của công việc, người sử dụng máy tính có thể tạo ra hàm phục vụ
cho nhu cầu riêng. Để minh hoạ, xét ví dụ: Nhân viên kế toán thường xuyên in ấn phiếu thu chi trong Excel
có nhu cầu tự động hóa việc tạo ra dòng diễn giải số tiền bằng chữ có thể tự xây dựng hàm có tên DOCSO
để giải quyết nhu cầu này. Trình tự tạo hàm như sau:
I. Tạo hàm sử dụng cho 1 bảng tính
• Mở bảng tính
• Kích Tools  Macro  Visual Basic Editor
(Hình 1)
• Xuất hiện khung soạn thảo Module
• Kích thực đơn Insert  Procedure Gõ tên của
hàm vào mục Name, chọn Type: Function  OK
(Hình 2)
• Chọn Font: Tools  Option  Editor Format
(Hình 3)
• Trở về khung soạn thảo, nhập nội dung của
hàm như sau:
Function Doc1(intDigit As integer) As String
Dim strNaming As String
strNaming = "một hai ba bốn năm sáu bảy tám chín"
Doc1 = Trim(Mid$(strNaming, (intDigit - 1) * 4 + 1, 4))
End Function
1
Hình 3
Hình 2
BẢN TIN KHOA HỌC, CAO ĐẲNG THƯƠNG MẠI - SỐ 03 (Q.II/2008)
Function Doc2(intDigit1 As Integer, intDigit2 As integer) As String
Dim strMuoi10 As String

Dim strTens As String
Dim strLam As String
Dim strMuoi As String
strLam = "lăm"
Select Case intDigit1
Case 0
Doc2 = Doc1(intDigit2)
Case 1
strMuoi10 = "mười"
If intDigit2 = 0 Then
Doc2 = strMuoi10
ElseIf intDigit2 <> 5 Then
Doc2 = strMuoi10 & " " & Doc1(intDigit2)
Else
Doc2 = strMuoi10 & " " & strLam

End If
Case Else
strMuoi = "mươi"
If intDigit2 = 0 Then
Doc2 = Doc1(intDigit1) & " " & strMuoi
ElseIf intDigit2 <> 1 And intDigit2 <> 5
Then
Doc2 = Doc1(intDigit1) & " " & strMuoi & " " & Doc1(intDigit2)
ElseIf intDigit2 = 1 Then
Doc2 = Doc1(intDigit1) & " " & strMuoi & " mốt"
ElseIf intDigit2 = 5 Then
Doc2 = Doc1(intDigit1) & " " & strMuoi & " " & strLam
End If
End Select

End Function
Function Doc3(intDigit1 As Integer, intDigit2 As Integer, intDigit3 As integer, Optional blnNhomDau As
Boolean = False) As String
Dim strTram As String
strTram = "trăm"
If intDigit1 = 0 And blnNhomDau = True Then
Doc3 = Doc2(intDigit2, intDigit3)
ElseIf intDigit1 = 0 And blnNhomDau = False Then
If intDigit2 > 0 Then
Doc3 = "không trăm " & " " & Doc2(intDigit2, intDigit3)
Else
Doc3 = "không trăm lẻ " & Doc1(intDigit3)
End If
ElseIf intDigit2 = 0 And intDigit3 = 0 Then
Doc3 = Doc1(intDigit1) & " " & strTram
ElseIf intDigit2 = 0 And intDigit3 > 0 Then
2
BẢN TIN KHOA HỌC, CAO ĐẲNG THƯƠNG MẠI - SỐ 03 (Q.II/2008)
Doc3 = Doc1(intDigit1) & " " & strTram & " lẻ " & Doc1(intDigit3)
Else
Doc3 = Doc1(intDigit1) & " " & strTram & " " & Doc2(intDigit2, intDigit3)
End If
End Function
Function DocSo(dblNumber As Double) As String
On Error GoTo ErrDocSo
Dim strFormatNumber As String
Dim intNumberLeftDigits As integer
Dim dblIntegerPart As Double
Dim intNumberParts As Long
Dim intRemainder As integer

Dim strIntegerPart As String
ReDim arrDigitParts(1 To 6, 1 To 3) As Integer
ReDim arrinWords(1 To 6, 1 To 2) As String
Dim I As Integer
Dim strThreeDigits As String
Dim intFirstIndex As Integer
Dim J As Integer
Dim strIntegerPartInWords As String
Dim strDecimalPart As String
Dim strDecimalPartInWords As String
Dim strNumberInWords As String
arrinWords(1, 2) = " ngàn"
arrinWords(2, 2) = " tỷ"
arrinWords(3, 2) = " triệu"
arrinWords(4, 2) = " ngàn"
arrinWords(5, 2) = ""
arrinWords(6, 2) = "xu"
strFormatNumber = Format$(dblNumber, "#0.00")
intNumberLeftDigits = Len(strFormatNumber) - 3
'Debug.Print Format(dblNumber, "#,#0.00")
If intNumberLeftDigits > 15 Then
MsgBox "Số có nhiều hơn 15 chữ số!"
DocSo = " Đồng"
Exit Function
End If
If dblNumber = 0 Then
DocSo = "Không Đồng"
Exit Function
End If
dblIntegerPart = Int(dblNumber)

strIntegerPart = Trim$(Str(dblIntegerPart))
intRemainder = intNumberLeftDigits Mod 3
If intRemainder = 0 Then
intNumberParts = intNumberLeftDigits / 3
ElseIf intRemainder = 1 Then
intNumberParts = Int(intNumberLeftDigits / 3) + 1
strIntegerPart = "00" & strIntegerPart
3
BẢN TIN KHOA HỌC, CAO ĐẲNG THƯƠNG MẠI - SỐ 03 (Q.II/2008)
Else
intNumberParts = Int(intNumberLeftDigits / 3) + 1
strIntegerPart = "0" & strIntegerPart
End If
intFirstIndex = 6 - intNumberParts
J = 0
For I = intFirstIndex To 5
J = J + 1
strThreeDigits = Mid$(strIntegerPart, (J - 1) * 3 + 1, 3)
arrDigitParts(I, 1) = Val(Left$(strThreeDigits, 1))
arrDigitParts(I, 2) = Val(Mid$(strThreeDigits, 2, 1))
arrDigitParts(I, 3) = Val(Mid$(strThreeDigits, 3, 1))
Next I
strDecimalPart = Right$(strFormatNumber, 2)
arrDigitParts(6, 2) = Val(Mid$(strDecimalPart, 1, 1))
arrDigitParts(6, 3) = Val(Mid$(strDecimalPart, 2, 1))
'For I = 1 To 6
'Debug.Print arrDigitParts(I, 1), arrDigitParts(I, 2), arrDigitParts(I, 3)
'Next I
For I = 1 To 6
If arrDigitParts(I, 1) = 0 And arrDigitParts(I, 2) = 0 And arrDigitParts(I, 3) = 0 Then

arrinWords(I, 1) = "zero"
ElseIf I = intFirstIndex Then
arrinWords(I, 1) = Doc3(arrDigitParts(I, 1), arrDigitParts(I, 2), arrDigitParts(I, 3), True)
Else
arrinWords(I, 1) = Doc3(arrDigitParts(I, 1), arrDigitParts(I, 2), arrDigitParts(I, 3))
End If
'Debug.Print arrinWords(I, 1), arrinWords(I, 2)
Next I
strIntegerPartInWords = ""
For I = intFirstIndex To 5
If arrinWords(I, 1) <> "zero" Then

strIntegerPartInWords = strIntegerPartInWords & " " & arrinWords(I, 1) & arrinWords(I, 2)
End If
Next I
If arrinWords(1, 1) <> "zero" And arrinWords(2, 1) = "zero" Then
strIntegerPartInWords = arrinWords(1, 1) & arrinWords(1, 2) & " " & arrinWords(2, 2)
For I = 3 To 5
If arrinWords(I, 1) <> "zero" Then
strIntegerPartInWords = strIntegerPartInWords & " " & arrinWords(I, 1) & arrinWords(I, 2)
End If
4
BẢN TIN KHOA HỌC, CAO ĐẲNG THƯƠNG MẠI - SỐ 03 (Q.II/2008)
Next I
End If
strIntegerPartInWords = strIntegerPartInWords & " đồng chẵn."
If arrDigitParts(6, 2) = 0 And arrDigitParts(6, 3) = 0 Then
arrinWords(6, 1) = "zero"
Else
arrinWords(6, 1) = Doc3(arrDigitParts(6, 1), arrDigitParts(6, 2), arrDigitParts(6, 3), True)

End If
'Debug.Print arrinWords(6, 1), arrinWords(6, 2)
strDecimalPartInWords = arrinWords(6, 1) & " " & arrinWords(6, 2)
If arrinWords(6, 1) <> "zero" Then
strNumberInWords = Trim(strIntegerPartInWords & " và " & strDecimalPartInWords)
Else
strNumberInWords = Trim(strIntegerPartInWords)
End If
DocSo = UCase$(Left$(strNumberInWords, 1)) & Mid$(strNumberInWords, 2)
ErrDocSo:
Exit Function
End Function
• Lưu: Kích vào nút lệnh Save
• Thoát khung soạn thảo: File  Close and Return Microsoft Excel
• Kiểm tra bằng cách kích vào f
x
và bắt đầu sử dụng sau khi khởi động và mở lại tập tin (chọn Enable
Macro khi có thông báo)
II. Tạo hàm sử dụng cho tất cả các bảng tính
Hàm DOCSO để có thể được sử dụng cho tất cả các bảng tính trong máy cần thực hiện thêm các bước
sau:
• Mở tập tin có chứa hàm tự tạo DOCSO
• Kích File  Save As  chọn Program Files  Microsoft Office  Office  Library  khai báo
mục Save As type: Microsoft Excel Add In; Name: nhập <Tên>.xla  Save (Hình 4)
• Trở về màn hình, kích Tools  Add In  Kích vào ô <Tên> trong khung Add In  OK (Hình 5)
5
Hình 4
Hình 5
BẢN TIN KHOA HỌC, CAO ĐẲNG THƯƠNG MẠI - SỐ 03 (Q.II/2008)
Trở về kiểm tra bằng cách kích vào f

x
(Hình 6 và 7) và bắt đầu sử dụng sau khi khởi động và mở lại tập
tin (chọn Enable Macro khi có thông báo)
Lưu ý:
- Bạn đọc có nhu cầu tạo và sử dụng hàm DOCSO, có thể liên hệ với Phòng KH&ĐN để chép đoạn mã
chương trình (dạng tập tin WORD) và dán vào khung soạn thảo Module;
- Hàm trên có khả năng xử lý con số có chiều dài tối đa 15 chữ số, muốn tăng khả năng xử lý chỉ cần
điều chỉnh một vài khai báo trong đoạn mã;
- Khi nhập nội dung đoạn mã chương trình cần chú ý khoảng cách dòng chữ "một hai ba bốn năm sáu
bảy tám chín".
Đoạn mã dịch số ra chữ có thể được viết bằng nhiều cách khác nhau, anh chị có thể tham khảo trong tài
liệu của tác giả Ông Văn Thông để biết thêm cách viết khác.
6
Hình 6
Hình 7