Học và luyện lập trình Visual Basic For Applications (VBA) với thầy Nguyễn Thế Anh, Cty CP Giá Xây Dựng, người truyền nhiệt huyết cho các kỹ sư xây dựng tự động hóa các công việc buồn tẻ, nhàm chán.
Bước khởi đầu rất quan trọng, nếu trơn tru và suôn sẻ thì sẽ tạo hứng khởi, ngược lại gặp lỗi không xử lý được thì bắt đầu nản. Thường chỉ cần có người dìu dắt được qua bước bỡ ngỡ ban đầu là sẽ ngon. Với các video và code mẫu dưới đây sẽ giúp bạn ra nhập thế giới lập trình VBA dễ dàng
# I. CÁC HÀM DỰNG
Hàm dựng là hàm Excel không có sẵn, do anh em mình dùng Excel rồi dựng ra (viết code, lập trình) theo yêu cầu riêng.
# 1. Hàm VND
Video này sẽ hướng dẫn bạn thêm đoạn mã VBA hàm VND vào file Excel để đọc số tiền thành bằng chữ. Hàm VND hữu ích cho các bạn kinh tế, tài chính, dự toán... những ai hay phải làm việc với bảng tính tiền và phải đọc số tiền thành bằng chữ.
Bạn copy code hàm VND sau để sử dụng:
Function vnd(conso) As String
Dim nSheet As String
nSheet = ActiveSheet.Name
If nSheet <> "VLHT XD" And nSheet <> "VLHT TB" Then
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))
If Trim(conso) = "" Then
vnd = ""
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"
ElseIf n3 = 4 And n2 <> 1 And n2 <> 4 And n1 = 4 Then S3 = " t" & ChrW$(432)
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
If docso <> "" And s123 <> "" Then
docso = docso & ","
End If
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
vnd = UCase(Left(dau & Trim(docso), 1)) & Mid(dau & Trim(docso), 2) & " " & ChrW$(273) & ChrW$(7891) & "ng."
If Left(vnd, 2) = "T" & ChrW(432) Then
vnd = "B" & ChrW(7889) & "n" & Right(vnd, (Len(vnd) - 2))
End If
Else
vnd = conso
End If
End If
End Function
# 2. Hàm USD
Tương tự hàm VND, nhưng hàm USD đọc số tiền Đô la thành chữ tiếng Anh. Bạn copy đoạn mã VBA thực hiện hàm USD vào file Excel và chạy.
Function USD(Tien)
If Tien = 0 Then
Toread = "None"
Else
SP = Space(1)
RR = Space(0)
Donvi = RR: Hchuc = RR: Khung = RR
Donvi = Donvi + "one two three four "
Donvi = Donvi + "five six seven eight "
Donvi = Donvi + "nine ten eleven twelve "
Donvi = Donvi + "thirteen fourteen fifteen sixteen "
Donvi = Donvi + "seventeeneighteen nineteen "
Hchuc = Hchuc + "twenty thirty forty fifty "
Hchuc = Hchuc + "sixty seventy eighty ninety "
Khung = Khung + "billion milion thousand dollars cents "
If Tien < 0 Then
Toread = "Minus "
Else
Toread = RR
End If
Chuoi = Format(Abs(Tien), "############.00")
Chuoi = Right(Space(12) + Chuoi, 15)
For i = 1 To 5
NHOM = Mid(Chuoi, i * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If i = 4 And Abs(Tien) > 1 Then
Word = "dollars "
Else
Word = RR
End If
Case ".00"
Word = "only"
Case Else
X = Val(Left(NHOM, 1))
Y = Val(Mid(NHOM, 2, 1))
Z = Val(Right(NHOM, 1))
W = Val(Right(NHOM, 2))
If X = 0 Then
Word = RR
Else
Word = Trim(Mid(Donvi, X * 9 - 8, 9)) + " hundred "
If W > 0 And W < 21 Then
Word = Word + "and "
End If
End If
If i = 5 And Abs(Tien) > 1 Then
Word = "and " + Word
End If
If W < 20 And W > 0 Then
Word = Word + Trim(Mid(Donvi, W * 9 - 8, 9)) + SP
Else
If W >= 20 Then
Word = Word + Trim(Mid(Hchuc, (Y - 1) * 9 - 8, 9)) + SP
If Z > 0 Then
Word = Word + Trim(Mid(Donvi, Z * 9 - 8, 9)) + SP
End If
End If
End If
Word = Word + Trim(Mid(Khung, i * 9 - 8, 9)) + SP
End Select
Toread = Toread + Word
End If
Next i
End If
USD = Trim(UCase(Left(Toread, 1)) + Mid(Toread, 2))
If Right(USD, 9) = "and cents" Then
USD = Left(USD, Len(USD) - 10)
End If
End Function
# 3. Hàm Khối lượng Kl
Hàm Kl giúp tính toán khối lượng công tác xây dựng. Ứng dụng trong các file phần mềm GXD như: phần mềm Dự toán GXD, Dự thầu GXD, Quyết toán GXD, Quản lý chất lượng GXD và file Excel bất kỳ.
Public Function kl(strText As String)
If Right(strText, 1) = " " Then
kl = "0"
Else
strText = Replace(strText, "m2", "")
strText = Replace(strText, "m3", "")
strText = Replace(strText, "M2", "")
strText = Replace(strText, "M3", "")
strText = Replace(strText, ",", ".")
If vitri(" ", strText) < Len(strText) And vitri(" ", strText) > 1 Then
strText = Right(strText, Len(strText) - vitri(" ", strText))
'Else
End If
kl = ""
For i = 1 To Len(strText)
kytu = Mid(strText, i, 1)
ktdb = Mid(strText, i, 4)
If kytu = "0" Or kytu = "1" Or kytu = "2" Or kytu = "3" Or kytu = "4" Or kytu = "5" Or kytu = "6" Or kytu = "7" _
Or kytu = "8" Or kytu = "9" Or kytu = "+" Or kytu = "-" Or kytu = "*" Or kytu = "/" Or kytu = "^" Or kytu = "." _
Or kytu = "," Or kytu = "(" Or kytu = ")" Or kytu = "%" Or kytu = "x" Or kytu = "X" Or ktdb = "sqrt" Or ktdb = "Sqrt" Or ktdb = "SQRT" Then
If ktdb = "sqrt" Or ktdb = "Sqrt" Or ktdb = "SQRT" Then
kytu = "sqrt"
End If
If kytu = "x" Or kytu = "X" Then
kytu = "*"
End If
kl = kl & kytu
End If
Next
If kl = "" Then
kl = 0
End If
End If
kl = kl + "+0"
If IsError(Evaluate(kl)) Then
kl = "0"
Else
kl = Evaluate(kl)
If kl = 0 Then
kl = "0"
End If
End If
End Function
# 4. Hàm dichthuat Google Translate
Hàm googletranslate giúp bạn dịch nhanh các hồ sơ dự toán, dự thầu, thanh quyết toán, quản lý chất lượng... Lập hàm và sao chép roạt ra hàng loạt, dữ liệu dịch vào luôn bảng tính. Dịch dựa vào Google Translate nên sau khi có dữ liệu bạn cần biên tập, chỉnh sửa thêm ngữ nghĩa.
Function dichthuat(sText As String, FromLang, ToLang)
Dim p1, p2, URL, resp
Const DIV_RESULT$ = "<div class=""result-container"">"
Const URL_TEMPLATE$ = "https://translate.google.com/m?hl=[from]&sl=[from]&tl=[to]&ie=UTF-8&prev=_m&q="
URL = URL_TEMPLATE & WorksheetFunction.EncodeURL(sText)
URL = Replace(URL, "[to]", ToLang)
URL = Replace(URL, "[from]", FromLang)
resp = WorksheetFunction.WebService(URL)
p1 = InStr(resp, DIV_RESULT)
If p1 Then
p1 = p1 + Len(DIV_RESULT)
p2 = InStr(p1, resp, "</div>")
dichthuat = Mid$(resp, p1, p2 - p1)
End If
End Function
# II. CÁC CHỨC NĂNG
# 1. Hiển thị tất cả sheet ẩn
Unhide all Hidden Worksheets. Đoạn code VBA này hiển thị tất cả các sheet đang ẩn thay vì bạn phải unhide từng sheet.
Sub UnhideAllWorksheet()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
End Sub
# 2. Ẩn tất cả ngoại trừ sheet hiện hành
Hide all but the Active Worksheet. Đoạn code VBA này ẩn tất cả các sheet ngoại trừ sheet đang hoạt động (sheet hiện hành). Không cần code, với Excel bạn kích vào sheet đầu và giữ Shift kích vào sheet cuối rồi kích phải vào tên sheet bất kỳ chọn Hide.
Sub HideWorksheet()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
# 3. Tạo mục lục link tới tất cả các sheet
Create links to all sheets. Đoạn mã VBA này sẽ nhanh chóng lấy tên tất cả các sheet trong file và gắn link vào tạo ra 1 Mục lục tiện lợi để bạn truy xuất tới các sheet dễ dàng và nhanh chóng.
Sub CreateLinksToAllSheets()
Dim sh As Worksheet
Dim cell As Range
Dim x As Integer
x = 1
For Each sh In ActiveWorkbook.Worksheets
If ActiveSheet.Name <> sh.Name Then
Range(Cells(ActiveCell.Row, ActiveCell.Column - 1).Address).Value = x
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
ActiveCell.Offset(1, 0).Select
x = x + 1
End If
Next sh
End Sub
# 4. Xóa các style rác
Delete all style. Nếu bạn thấy file Excel chạy ì ạch, cứ như là bấm 1 lệnh rồi đi pha 1 ly cà phê rồi quay lại mới chạy xong. Thì đoạn code VBA nhỏ sau giúp file của bạn nhẹ và chạy nhanh hơn. Đoạn code VBA này được lập trình để xóa nhanh tất cả các Style rác, không dùng đến trong file nhưng lại gây nặng file và chạy chậm.
Sub StyleKill()
Dim styT As Style
Dim intRet As Integer
On Error Resume Next
For Each styT In ActiveWorkbook.Styles
If Not styT.BuiltIn Then
If styT.Name <> "1" Then styT.Delete
End If
Next styT
End Sub
# 5. Sao chép siêu liên kết giữa các ô trong Excel
Khi nâng cấp file phần mềm QLTL GXD, QLDA GXD, GSXD GXD cần copy siêu liên kết (Hyperlink) từ các vùng ô ở cột này sang cột khác tôi đã dùng Macro dưới đây, rất nhanh và hiệu quả. Bạn có thể sử dụng cho nhiều tình huống khác khi bạn muốn. Một điều rất hay nữa là qua Macro đơn giản này bạn biết cách tạo ra hộp thoại với tiêu đề, thông điệp và ô Input.
Sub CopyHyperlinks()
'Uodateby Extendoffice
Dim xSRg As Range
Dim xDRg As Range
Dim I As Integer
Dim xAddress As String
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xSRg = Application.InputBox("Hay chon vung ban muon copy hyperlinks:", "GXD sao chep Hyperlink", xAddress, , , , , 8)
If xSRg Is Nothing Then Exit Sub
Set xDRg = Application.InputBox("Hay chon vung ban muon dan hyperlinks:", "GXD sao chep Hyperlink", , , , , , 8)
If xDRg Is Nothing Then Exit Sub
Set xDRg = xDRg(1)
For I = 1 To xSRg.Count
If xSRg(I) <> "" And xDRg.Offset(I - 1) <> "" Then
If xSRg(I).Hyperlinks.Count = 1 Then
xDRg(I).Hyperlinks.Add xDRg(I), xSRg(I).Hyperlinks(1).Address
End If
End If
Next
End Sub
# 6. Thiết lập môi trường lập trình VBA Excel thuận lợi nhất cho người mới
# 7. Nhập cuộc lập trình VBA Excel đơn giản và dễ dàng nhất cho người mới bắt đầu
# 8. Fully Automated Data Entry User Form in Excel
Một video kèm theo tài liệu hướng dẫn bạn từng bước tạo form nhập dữ liệu trong Excel với hộp thoại, nút bấm và các ô nhập liệu khá là đẹp. Đây là 1 dự án nho nhỏ đáng để bạn thực hành theo, để có thể áp dụng vào nhiều công việc phải nhập liệu.
# 9. Xóa các sheet ẩn
Có lúc file Excel của bạn có chứa nhiều Sheet ẩn mà không cần đến nữa bạn có thể xóa nhanh những Sheet ẩn bằng đoạn code dưới đây. Hoặc bạn muốn xóa nhiều sheet chỉ việc ẩn chúng đi rồi dùng đoạn code dưới, việc ẩn đi như là để đánh dấu rằng các sheet này cần xóa đi.
Sub Delete_Hidden_Sheets()
j = 1
While j <= Worksheets.Count
If Not Worksheets(j).Visible Then
Worksheets(j).Delete
Else
j = j + 1
End If
Wend
End Sub
- Hãy truy cập Kênh video bấm Sucrible (đăng ký kênh) để có bài giảng mới youtube sẽ gửi thông báo cho bạn nhé.
- Nếu bạn gặp vướng mắc gì hãy gửi lên group facebook mình và nhiều bạn nhiệt tình sẽ chỉ dẫn hoặc hỗ trợ nhé. Link facebook ở trên menu đầu trang.
- Các nội dung ở trang này sẽ thường xuyên được biên tập thay đổi và cập nhật. Hãy ghé thăm thường xuyên nhé.
Chúc bạn nhiều thành công.