18 mã VBA Excel hữu ích giúp tiết kiệm thời gian

0
6

Cách cài đặt macro
Trong Excel, nhấn tổ hợp phím alt + F11. Điều này sẽ đưa bạn đến trình soạn thảo VBA trong MS Excel. Sau đó, bấm chuột phải vào thư mục Đối tượng Microsoft Excel ở bên trái và chọn Chèn => Mô-đun. Đây là nơi lưu trữ các macro. Để sử dụng macro, bạn cần lưu tài liệu Excel dưới dạng macro. Từ tệp tab => lưu dưới dạng, chọn lưu dưới dạng sổ làm việc hỗ trợ macro (tiện ích mở rộng .xlsm) Bây giờ, đã đến lúc viết macro đầu tiên của bạn!

Sao chép dữ liệu từ tệp này sang tệp khác.

Macro rất hữu ích, vì nó cho thấy cách sao chép một phạm vi dữ liệu từ bên trong vba và cách tạo và đặt tên cho một bảng tính mới. Bạn có thể dễ dàng nâng cấp nó để phù hợp với yêu cầu của riêng bạn:

Sub CopyFiletoAnotherWorkbook ()
'Sao chép các bảng dữ liệu
( "Ví dụ 1" ) .Range ( "B4: C15" ) .Copy
' Tạo một bảng tính mới
Sách bài tập
'Dán dữ liệu
ActiveSheet.Paste
'Tắt cảnh báo
ứng dụng Application.DisplayAlerts = false
' Lưu tệp mới. Thay đổi tên của thư mục.
ActiveWorkbook.SaveAs Tên tệp: = "C: \ Temp \ MyNewBook.xlsx"
'Bật lại cảnh báo ứng dụng trên
Application.DisplayAlerts = True
End Sub

Hiển thị các hàng ẩn

Đôi khi, các tệp Excel lớn chứa các dòng ẩn để rõ ràng hơn. Đây là một macro sẽ bỏ ẩn tất cả các hàng từ một bảng tính hoạt động:

Sub ShowHiddenRows ()
Cột.EntireColumn.Hidden = false
Rows.EntireRow.Hidden = false
End Sub

Xóa các hàng và cột trống

Các hàng trống trong Excel là một vấn đề với xử lý dữ liệu. Đây là cách để loại bỏ chúng:

Sub DeleteEmptyRowsAndColumns ()
'Khai báo các biến của bạn.
Dim MyRange As Range
Dim iCount As Long
'Xác định Phạm vi mục tiêu.
Đặt MyRange = ActiveSheet.UsedRange
'Bắt đầu vòng lặp ngược qua phạm vi Hàng.
Đối với iCount = MyRange.Rows.Count To 1 Bước -1
'Nếu toàn bộ hàng trống thì xóa nó.
Nếu Application.CountA (Hàng (iCount) .EntireRow) = 0 Sau đó
Hàng (iCount) .Delete
'Xóa nhận xét để xem hàng nào
' MsgBox "hàng" & iCount & "trống"
Kết thúc nếu
'Tăng bộ đếm xuống
Tiếp theo iCount
' Bước 6: Bắt đầu vòng lặp ngược qua phạm vi Cột.
Đối với iCount = MyRange.Columns.Count To 1 Bước -1
'Bước 7: Nếu toàn bộ cột trống thì xóa nó.
Nếu Application.CountA (Cột (iCount) .EntireColumn) = 0 Sau đó
Cột (iCount) .Xóa
Kết thúc nếu
'Bước 8: Tăng bộ đếm xuống
Tiếp theo iCount
End Sub

Tìm một ô trống

Sub FindEmptyCell ()
ActiveCell. Offerset ( 1 , 0 ). Chọn
Do While Not IsEmpty (ActiveCell)
ActiveCell. Offerset ( 1 , 0 ). Chọn
vòng lặp kết thúc phụ

Thay thế các ô trống bằng một giá trị.

Như đã đề cập trước đây, các ô trống can thiệp vào xử lý dữ liệu và tạo các bảng trụ. Đây là một mã thay thế tất cả các ô trống bằng 0. Macro này có ứng dụng rất lớn vì bạn có thể sử dụng nó để tìm và thay thế kết quả N / A, cũng như các ký tự khác như dấu chấm, dấu phẩy hoặc giá trị trùng lặp:

Sub FindAndReplace ()
'Khai báo các biến của bạn
Dim MyRange As Range
Dim MyCell As Range
' Lưu Workbook trước khi thay đổi các ô?
Chọn Case MsgBox ( "Không thể hoàn tác hành động này." & _
"Lưu sổ làm việc trước?" , VbYesNo Hủy)
Case Is = vbYes
ThisWorkbook.Save
Case Is = vb Hủy
Thoát Sub
End Chọn
'Xác định Phạm vi đích.
Đặt MyRange = Lựa chọn
'Bắt đầu lặp qua phạm vi.
Đối với mỗi MyCell trong MyRange
'Kiểm tra độ dài bằng 0, sau đó thêm 0.
Nếu Len (MyCell.Value) = 0 Sau đó
MyCell = 0
End If
' Nhận ô tiếp theo trong phạm vi
Tiếp theo MyCell
End Sub

Sắp xếp số

Các macro sau sắp xếp theo thứ tự tăng dần tất cả các số từ cột của ô hiện hoạt. Chỉ cần nhấp đúp vào bất kỳ ô nào từ một cột bạn muốn sắp xếp. Lưu ý: Bạn cần đặt mã trong Bảng 1 chứ không phải trong mô-đun để hoạt động:

Bảng tính phụ riêng tư_ BeforeDoubleClick ( Mục tiêu ByVal là Phạm vi, Hủy dưới dạng  Boolean )      'Khai báo biến của bạn          Dim LastRow As  Long      ' Tìm hàng cuối          LastRow = Cells (Rows.Count, 1 ). Kết thúc (xlUp) .Row      'Sắp xếp tăng dần trên          hàng cột nhấp đúp ( "6:" & LastRow) .Sort 
Khóa1: = Các ô ( 6 , ActiveCell.Column), _
Thứ tự1: = xlAsceinating
Kết thúc phụ

Xóa các khoảng trống

Đôi khi, dữ liệu trong sổ làm việc chứa các khoảng trắng (khoảng trắng) bổ sung có thể can thiệp vào phân tích dữ liệu và làm hỏng các công thức. Đây là một macro sẽ loại bỏ tất cả các khoảng trắng khỏi một phạm vi ô được chọn trước:

Sub TrimTheSpaces ()
'Khai báo các biến của bạn
Dim MyRange As Range
Dim MyCell As Range
' Lưu Workbook trước khi thay đổi ô
Chọn Case MsgBox ( "Không thể hoàn tác hành động này." & _
"Lưu Workbook trước?" , VbYesNoftime)
Case Is = vbYes
ThisWorkbook.Save
Case Is = vb Hủy
Thoát Sub
End Chọn
'Xác định Phạm vi đích.
Đặt MyRange = Lựa chọn
'Bắt đầu lặp qua phạm vi.
Đối với mỗi MyCell trong MyRange
'Cắt các không gian.
Nếu không phải là IsEmpty (MyCell) thì
MyCell = Trim (MyCell)
Kết thúc Nếu
'Nhận ô tiếp theo trong phạm vi
Tiếp theo MyCell
Kết thúc phụ

Làm nổi bật các giá trị được công bố

Đôi khi có các giá trị trùng lặp trong một số cột chúng tôi muốn chiếu sáng. Đây là một macro thực hiện điều đó:

Sub HighlightD repeatates ()
'Khai báo các biến của bạn
Dim MyRange As Range
Dim MyCell As Range
' Xác định Phạm vi mục tiêu.
Đặt MyRange = Lựa chọn
'Bắt đầu lặp qua phạm vi.
Đối với mỗi MyCell trong MyRange
'Đảm bảo ô có định dạng Văn bản.
If WorksheetFunction.Count If (MyRange, MyCell.Value)> 1 Sau đó
MyCell.Interior.ColorIndex = 36
End If
'Nhận ô tiếp theo trong phạm vi
Kết thúc MyCell
Tiếp theo Sub

Đánh dấu mười giá trị hàng đầu

Mã này sẽ làm nổi bật mười giá trị hàng đầu từ một lựa chọn các ô:

Sub TopTen ()
Lựa chọn.FormatConditions.AddTop10
Lựa chọn.FormatConditions (Lựa chọn.FormatConditions.Count). SetFirstP Warriority
Với Lựa chọn.FormatConditions ( 1 )
.TopBottom = xlTop10Top
'Thay đổi thứ hạng ở đây để làm nổi bật một số khác nhau của các giá trị
.Rank = 10
.Percent = False
End Với
Với Selection.FormatConditions ( 1 ) .Font
.Color = -16752384
.TintAndShade = 0
End Với
Với Selection.FormatConditions ( 1 ) .Interior
.PotypeColorIndex = xlAutomatic.Color
= 13561798
.TintAndShade = 0
Kết thúc với
lựa chọn.FormatConditions ( 1 ) .Stop IfTrue = false
End Sub

Bạn có thể dễ dàng điều chỉnh mã để làm nổi bật số lượng giá trị khác nhau.

Đánh dấu lớn hơn giá trị

Khi bạn chạy mã này, một cửa sổ sẽ nhắc. Nó sẽ hỏi bạn giá trị bạn muốn so sánh các ô bạn đã chọn.

Sub HighlightGreaterThanValues ()
Dim i Như Integer
i = InputBox ( "Nhập lớn hơn giá trị" , "Nhập giá trị gia tăng" )
Lựa chọn.FormatConditions.Delete
'Thay đổi Toán tử thành xlLower để tô sáng thấp hơn giá trị
Lựa chọn.FormatConditions.Add Type: = xlCellValue, Toán tử : = xlG [, Formula1: = i
Lựa chọn.FormatConditions (Lựa chọn.FormatConditions.Count). SetFirstP Warriority
Với Lựa chọn.FormatConditions ( 1 )
.Cont.Color = RGB ( 0 , 0 , 0 )
.Interior.Color = RGB ( 31 , 218 , 154 )
End Với
End Sub

Bạn cũng có thể điều chỉnh mã này để làm nổi bật các giá trị thấp hơn.

Đánh dấu các ô có ý kiến

Một macro đơn giản làm nổi bật tất cả các ô có chứa các nhận xét:

Sub HighlightVerCells ()
Lựa chọn. SpecialCells (xlCellTypeComments). Chọn
Lựa chọn.Style = "Note"
End Sub

Các ô nổi bật với các từ sai chính tả

Điều này cực kỳ hữu ích khi bạn làm việc với các hàm lấy chuỗi, tuy nhiên, ai đó đã nhập chuỗi bị lỗi và công thức của bạn không hoạt động. Đây là cách khắc phục vấn đề này:

Sub ColorMispellingCells ()
cho mỗi cl trong ActiveSheet.UsedRange
If Not Application.CheckSpelling (Word: = cl. Text ) Sau đó _
cl.Interior.ColorIndex = 28
Tiếp theo cl
End Sub

Tạo một bảng trụ

Dưới đây là cách tạo bảng xoay vòng từ MS Excel (phiên bản 2007). Đặc biệt hữu ích, khi bạn đang làm một báo cáo tùy chỉnh mỗi ngày. Bạn có thể tối ưu hóa việc tạo bảng trụ theo cách sau:

Sub PivotTableForExcel2007 ()
Dim SourceRange As Range
Set SourceRange = Sheets ( "Sheet1" ) .Range ( "A3: N86" )
ActiveWorkbook.POLLCaches.Create (_
SourceType: = xlDatabase, _
SourceData: = SourceRange, _
Phiên bản: = xlP PivotTableVersion12) .CreateP PivotTable _
Bảng biểu: = "" , _
Tên bảng: = "" , _
Mặc địnhVersion: = xlP PivotTableVersion12
Kết thúc phụ

Đính kèm sổ làm việc đang hoạt động trong Email

Mã VBA yêu thích của tôi. Nó cho phép bạn đính kèm và gửi tệp bạn đang làm việc với một địa chỉ email, tiêu đề thư và nội dung thư được xác định trước! Trước tiên, bạn cần đặt tham chiếu cho Microsoft Outlook (trong trình chỉnh sửa VBA của bạn, nhấp vào công cụ => tài liệu tham khảo và chọn Microsoft Outlook).

Sub SendFIleAsAttachment ()
'Khai báo các biến của bạn
' Đặt tham chiếu đến thư viện đối tượng Microsoft Outlook
Dim OLApp As Outlook.Application
Dim OLMail As Object
'Open Outlook bắt đầu một mục thư mới
Đặt OLApp = New Outlook.Application
Set OLMail = OLApp.CreateItem ( 0 )
OLApp.Session.Logon
'Xây dựng mục thư của bạn và gửi
với OLMail
. To = "admin@datapigtechnologists.com; mike@datapigtechnologists.com"
.CC = ""
.BCC = ""
.Subject = "Đây là dòng Tiêu đề"
.Body = "Xin chào"
.Attachments.Add ActiveWorkbook.FullName
.Display 'Thay đổi thành. Gửi để gửi mà không xem lại
Kết thúc với
' Dọn dẹp bộ nhớ
Đặt OLMail = Không có gì
Đặt OLApp = Không có gì kết
thúc phụ

Gửi tất cả các biểu đồ Excel đến bản trình bày PowerPoint

Một macro rất tiện dụng cho phép bạn thêm tất cả các biểu đồ Excel trong bản trình bày Powerpoint của bạn chỉ bằng một cú nhấp chuột:

Sub SendExcelFftimeToPowerPoint ()
'Đặt tham chiếu đến Thư viện đối tượng Microsoft Powerpoint
' Khai báo các biến của bạn
Dim PP dưới dạng PowerPoint.
Ứng dụng Dim PPPres As PowerPoint.Pftimeation
Dim PPSlide As PowerPoint.Slide
Dim i As Integer
'Kiểm tra biểu đồ; thoát nếu không có biểu đồ nào tồn tại
Sheets ( "Slide Data" ). Chọn
If ActiveSheet.ChartObjects.Count < 1 Sau đó
MsgBox "Không có biểu đồ nào tồn tại trang tính hoạt động"
Thoát
Kết thúc phụ Nếu
'Mở PowerPoint và tạo bản trình bày mới
Đặt PP = PowerPoint
mới. Ứng dụng Đặt PPPres = PP.Pftimeations.Add
PP.Visible = True
'Bắt đầu vòng lặp dựa trên số biểu đồ
For i = 1 To ActiveSheet.ChartObjects.Count
' Sao chép biểu đồ dưới dạng hình ảnh
ActiveSheet.ChartObjects (i) .Chart.CopyPicture _
Kích thước: = xlScreen, Định dạng: = xlPicture
Application.Wait (Now + TimeValue ( "0: 00: 1" ))
'Đếm các slide và thêm slide mới như số slide có sẵn tiếp theo
ppSlideCount = PPPres.Slides.Count
Đặt PPSlide = PPPres.Slides.Add (SlideCount + 1 , ppLayoutBlank)
PPSlide. Chọn
'Dán hình ảnh và điều chỉnh vị trí của nó; Chuyển đến biểu đồ tiếp theo
PPSlide.Shapes.Paste. Chọn
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, Đúng
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, Đúng
Tiếp i
'Memory Cleanup
Set PPSlide = Không có gì
Set PPPres = Không có gì
Set PP = Không có gì
End Sub

Gửi bảng Excel trong MS Word

Các bảng Excel thường được đặt bên trong các tài liệu văn bản. Đây là một cách tự động để xuất bảng Excel của bạn sang MS Word:

Sub ExcelTableInWord ()
'Đặt tham chiếu đến thư viện Microsoft Word Object
' Khai báo các biến của bạn
Dim MyRange As Excel.Range
Dim wd As Word.Application
Dim wdDoc As Word.Document
Dim WdRange As Word.Range
'Sao chép phạm vi
Bảng đã xác định ( "Bảng doanh thu " ) .Range ( "B4: F10" ) .Cop
'mở mục tiêu tài liệu Word
Set WD = New Word.Application
Set wdDoc = wd.Documents.Open _
(ThisWorkbook.Path & "\" & "PasteTable.docx" )
wd.Visible = True
'Đặt tiêu điểm vào dấu trang đích
Đặt WdRange = wdDoc.Bookmark ( "DataTableHere" ) .Rangе
' Xóa bảng cũ và dán mới
On Error Resume Next
WdRange.Tables ( 1 ) .Delete
WdRange.Paste 'dán vào bảng
' Điều chỉnh độ rộng cột
WdRange.Tables ( 1 ) .Columns.SetWidth _
(MyRange.Width / MyRange.Columns.Count), wdAdjustSameWidth
'Đặt lại dấu trang
wdDoc.Bookmark. Thêm "DataTableHere" , WdRange
' Bộ nhớ dọn dẹp
Bộ wd = nothing
Set wdDoc = nothing
Set WdRange = nothing
End Sub

Trích xuất một từ cụ thể từ một ô

Chúng ta có thể sử dụng các công thức nếu chúng ta muốn trích xuất một số ký hiệu nhất định. Nhưng điều gì sẽ xảy ra nếu chúng ta chỉ muốn trích xuất từ ​​thứ hai từ một câu hoặc một phạm vi từ trong một ô? Để làm điều này, chúng ta có thể tạo một hàm Excel tùy chỉnh với VBA. Đây là một trong những chức năng VBA quan trọng nhất, bởi vì nó cho phép bạn tạo các chức năng của riêng bạn không tồn tại trong MS Excel. Chúng ta hãy tiếp tục và tạo hai hàm: findword () và findwordrev (). Đây là mã vba cho việc này:

Chức năng FindWord (Nguồn Như  Chuỗi , Chức Như  Integer ) Như  Chuỗi 
On Lỗi Resume Tiếp
FindWord = Split (WorksheetFunction.Trim (Nguồn), "" ) (Chức vụ - 1 )
Mở Lỗi GoTo 0
End Function
Chức năng FindWordRev (Nguồn Như  Chuỗi , Chức Như  Integer ) Như  Chuỗi 
Dim Giờ đến () Như Chuỗi
arr = VBA.Split (WorksheetFunction.Trim (Nguồn), "" )
Mở Lỗi Resume Tiếp
FindWordRev = Giờ đến (UBound (arr) - Chức vụ + 1 )
Khi Lỗi GoTo 0
Kết thúc chức năng

Rất hay, chúng tôi đã tạo hai hàm cstom Excel. Bây giờ, hãy thử sử dụng chúng trong Excel. Hàm = FindWordRev (A1,1) lấy từ cuối cùng từ ô A1. Hàm = FindWord (A1,3) lấy từ thứ ba từ ô A1, v.v.

Bảo vệ sách bài tập của bạn

Đôi khi chúng tôi muốn bảo vệ dữ liệu trong tệp của mình để chỉ chúng tôi mới có thể thay đổi dữ liệu. Đây là cách để làm điều này với VBA:

Sub ProtectSheets ()
'Khai báo các biến của bạn
Dim ws Như Worksheet
' Bắt đầu vòng lặp qua tất cả các bảng tính
Đối Mỗi ws Trong ActiveWorkbook.Worksheets
loop Protect và' để cạnh bảng
ws.Protect Password: = "1234"
Tiếp WS
End Sub

Chúc các bạn thành công! Tham khảo khóa học VBA Excel tại NIIT-ICT Hà Nội

Xem thêm: 5 cách sử dụng cho Macro VBA trong Excel với công việc của bạn

LEAVE A REPLY

Please enter your comment!
Please enter your name here