18 Mã VBA Excel Hữu ích Giúp Tiết Kiệm Thời Gian

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