Thịnh Hành 5/2024 # Top 100 Mã Excel Vba Macros Hữu Dụng # Top 8 Yêu Thích

Top 100 mã Excel VBA Macros hữu dụng

8/28/2024

Bạn có thể sử dụng những mã code này ngay cả khi bạn chưa từng sử dụng VBA trước đây.

Nhưng điều đầu tiên phải biết là:

Mã Macro là gì?

Trong Excel, mã macro là một mã lập trình được viết bằng ngôn ngữ VBA (Visual Basic for Applications).

Ý tưởng đằng sau việc sử dụng mã là để tự động hóa một hành động mà nếu không bạn phải thực hiện thủ công trong Excel.

Sử dụng mã Macro trong Excel

Trước khi sử dụng những mã này, đảm bảo rằng bạn có Developer Tab trên thanh Excel để truy cập VB Editor.

Sau khi bạn kích hoạt Developer Tab…

Di chuyển đến developer tab của bạn và

nhấp chọn “Visual Basic”.

Phía bên trái trên “Project Window”, nhấp chuột phải vào tên workbook của bạn và chèn vào một module mới.

Dán mã code của bạn vào trong module đó và đóng lại.

Bây giờ, di chuyển đến developer tab và nhấp chuột vào Macro.

Macro sẽ hiển thị một cửa sổ danh sách các macro có trong tệp của bạn, từ đó bạn có thể chạy các macro có trong danh sách đó.

BASIC CODE

Những mã code VBA này sẽ giúp bạn thực hiện một số công việc cơ bản trong nháy mắt mà bạn thường làm trên bảng tính.

Add Serial Numbers (đánh số thự tự tự động)

Code macro này sẽ giúp bạn bổ sung số serial tự động trên trang Excel.

Sau khi bạn chạy mã macro này, màn hình sẽ hiển thị input box để bạn nhập tối đa số serial và sau đó, nó sẽ chèn các số vào cột theo thứ tự.

Sub AddSerialNumbers()

Dim i As Integer

On Error GoTo Last

i = InputBox("Enter Value", "Enter Serial Numbers")

For i = 1 To i

ActiveCell.Value = i

ActiveCell.Offset(1, 0).Activate

Next i

Last:Exit Sub

End Sub

    Add Multiple Columns (chèn cột)

    Sau khi chạy mã macro, màn hình sẽ hiển thị một input box và bạn phải nhập số cột mà bạn muốn chèn.

    Sub InsertMultipleColumns()

    Dim i As Integer

    Dim j As Integer

    ActiveCell.EntireColumn.Select

    On Error GoTo Last

    i = InputBox(“Enter number of columns to insert”, “Insert         Columns”)

    For j = 1 To i

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove

    Next j

    Last:Exit Sub

    End Sub

      Add Multiple Rows (chèn dòng)

      Sau khi chạy mã macro, màn hình sẽ hiển thị một input box và bạn phải nhập số hàng mà bạn muốn chèn.

      Sub InsertMultipleRows()

      Dim i As Integer

      Dim j As Integer

      ActiveCell.EntireRow.Select

      On Error GoTo Last

      i = InputBox(“Enter number of columns to insert”, “Insert

      Columns”)

      For j = 1 To i

      Selection.Insert Shift:=xlToDown,

      CopyOrigin:=xlFormatFromRightorAbove

      Next j

      Last:Exit Sub

      End Sub                 

        Auto Fit Columns (tự động canh các cột)

        Nhanh chóng tự động khớp tất cả các hàng trong worksheet của bạn.

        Mã macro này sẽ chọn tất cả các ô trong worksheet và tự động khớp ngay lập tức các cột.

        Sub AutoFitColumns()

        Cells.Select

        Cells.EntireColumn.AutoFit

        End Sub

          Auto Fit Rows (tự động canh các dòng)

          Bạn có thể sử dụng mã code này để tự động khớp tất cả các hàng trong worksheet.

          Khi bạn chạy mã này, nó sẽ chọn tất cả các ô trong worksheet và tự động khớp ngay lập tức các hàng.

          Sub AutoFitRows()

          Cells.Select

          Cells.EntireRow.AutoFit

          End Sub

            Remove Text Wrap (bỏ chế độ wrap text)

            Mã code này sẽ giúp bạn xóa text wrap khỏi toàn bộ worksheet với một cái nhấp chuột. Đầu tiên nó sẽ chọn tất cả các cột và sau đó xóa text wrap và tự động khớp các hàng và cột.

            Sub RemoveWrapText()

            Cells.Select

            Selection.WrapText = False

            Cells.EntireRow.AutoFit

            Cells.EntireColumn.AutoFit

            End Sub

              Unmerge Cells (không kết nối các ô)

              Chọn các ô và chạy mã này, nó sẽ không sát nhập tất cả các ô vừa chọn với dữ liệu bị mất của bạn.                                            

              Sub UnmergeCells()

              Selection.UnMerge

              End Sub

                Open Calculator (mở máy tính trên excel)

                Trong cửa sổ có một máy tính cụ thể và sử dụng mã macro này, bạn có thể mở máy tính trực tiếp từ Excel cho việc tính toán.

                Sub OpenCalculator()

                Application.ActivateMicrosoftApp Index:=0

                End Sub

                  Add Header/Footer Date (thêm ngày ở chân trang/đầu trang)

                  Sử dụng mã này để bổ sung ngày vào phần header và footer trong worksheet.

                  Bạn có thể điều chỉnh mã này để đổi từ header sang footer.

                  Sub dateInHeader()

                  With ActiveSheet.PageSetup

                  .LeftHeader = “”

                  .CenterHeader = “&D”

                  .RightHeader = “”

                  .LeftFooter = “”

                  .CenterFooter = “”

                  .RightFooter = “”

                  End With

                  ActiveWindow.View = xlNormalView

                  End Sub

                    Custom Header/Footer (chèn đầu trang/chân trang theo ý bạn)

                    Nếu bạn muốn chèn header tùy chỉnh thì đây là một mã dành cho bạn.

                    Chạy mã này, nhập giá trị tùy chỉnh vào input box. Để thay đổi liên kết của header hoặc footer, bạn có thể điều chỉnh mã.

                    Sub customHeader()

                    Dim myText As Stringmy

                    Text = InputBox(“Enter your text here”, “Enter Text”)

                    With ActiveSheet.PageSetup

                    .LeftHeader = “”

                    .CenterHeader = myText

                    .RightHeader = “”

                    .LeftFooter = “”

                    .CenterFooter = “”

                    .RightFooter = “”

                    End With

                    End Sub 

                    Formatting Codes

                    Những mã VBA này sẽ giúp bạn định dạng các ô và phạm vi bằng cách sử dụng một số tiêu chuẩn và điều kiện cụ thể.

                      Highlight Duplicates from Selection (tô màu các ô cùng giá trị trong vùng được chọn)

                      Mã macro này sẽ kiểm tra mỗi ô bạn chọn và làm nổi bật các giá trị trùng lặp.    

                      Bạn cũng có thể thay đổi màu sắc từ mã này.

                      Sub HighlightDuplicateValues()

                      Dim myRange As Range

                      Dim myCell As Range

                      Set myRange = Selection

                      For Each myCell In myRange

                      myCell.Interior.ColorIndex = 36

                      End If

                      Next myCell

                      End Sub

                        Highlight the Active Row and Column

                        Đây là những bước để thực hiện mã code này nhanh chóng.

                        Mở VBE (ALT + F11).

                        Di chuyển đến Project Explorer (Crtl + R, If hidden).

                        Chọn workbook của bạn và nhấp đúp chuột vào tên một worksheet cụ thể mà bạn muốn kích hoạt mã macro.

                        Đóng VBE và bạn đã hoàn thành.

                        Hãy lưu ý rằng, khi áp dụng mã macro này bạn sẽ không thể điều chỉnh ô bằng cách nhấp đúp chuột.

                        Cancel As Boolean)

                        Dim strRange As String

                        strRange = Target.Cells.Address & “,” Target.Cells.EntireColumn.Address & “,” & _

                        Target.Cells.EntireRow.Address

                        Range(strRange).Select

                        End Sub

                          Highlight Top 10 Values

                          Chỉ chọn một phạm vi và chạy mã macro này và nó sẽ làm nổi bật top 10 values với màu xanh.

                          Sub TopTen()

                          Selection.FormatConditions.AddTop10

                          Selection.FormatConditions(Selection.FormatConditions.Count).S

                          tFirstPriority

                          With Selection.FormatConditions(1)

                          .TopBottom = xlTop10Top

                          .Rank = 10

                          .Percent = False

                          End With

                          With Selection.FormatConditions(1).Font

                          .Color = -16752384

                          .TintAndShade = 0

                          End With

                          With Selection.FormatConditions(1).Interior

                          .PatternColorIndex = xlAutomatic

                          .Color = 13561798

                          .TintAndShade = 0

                          End With

                          Selection.FormatConditions(1).StopIfTrue = False

                          End Sub

                            Highlight Named Ranges

                            Nếu bạn không chắc chắn bao nhiêu phạm vi được chỉ định trong worksheet của bạn thì bạn có thể sử dụng mã này để làm nổi bật chúng.

                            Sub HighlightRanges()

                            Dim RangeName As Name

                            Dim HighlightRange As Range

                            On Error Resume Next

                            For Each RangeName In ActiveWorkbook.Names

                            Set HighlightRange = RangeName.RefersToRange

                            HighlightRange.Interior.ColorIndex = 36

                            Next RangeName

                            End Sub

                              Highlight Greater than Values

                              Sau khi chạy mã này, nó sẽ yêu cầu giá trị mà bạn muốn làm nổi bật các giá trị lớn hơn.

                              Sub HighlightGreaterThanValues()

                              Dim i As Integer

                              i = InputBox(“Enter Greater Than Value”, “Enter Value”)

                              Selection.FormatConditions.Delete

                              Selection.FormatConditions.Add Type:=xlCellValue,

                              Operator:=xlGreater, Formula1:=i

                              Selection.FormatConditions(Selection.FormatConditions.Count).S

                              tFirstPriority

                              With Selection.FormatConditions(1)

                              .Font.Color = RGB(0, 0, 0)

                              .Interior.Color = RGB(31, 218, 154)

                              End With

                              End Sub

                                Highlight Lower than Values

                                Sau khi chạy mã này, nó sẽ yêu cầu giá trị mà bạn muốn làm nổi bật các giá trị thấp hơn.

                                Sub HighlightLowerThanValues()

                                Dim i As Integer

                                i = InputBox(“Enter Lower Than Value”, “Enter Value”)

                                Selection.FormatConditions.Delete

                                Selection.FormatConditions.Add Type:=xlCellValue,

                                Operator:=xlLower, Formula1:=i

                                Selection.FormatConditions(Selection.FormatConditions.Count).S

                                tFirstPriority

                                With Selection.FormatConditions(1)

                                .Font.Color = RGB(0, 0, 0)

                                .Interior.Color = RGB(217, 83, 79)

                                End With

                                End Sub

                                  Highlight Negative Numbers

                                  Chọn một pham vi các ô và chạy mã này. Nó sẽ kiểm tra mỗi ô trong phạm vi này và làm nổi bật tất cả các ô có (negative numbers).

                                  Sub highlightNegativeNumbers()

                                  Dim Rng As Range

                                  For Each Rng In Selection

                                  If WorksheetFunction.IsNumber(Rng) Then

                                  If Rng.Value < 0 Then

                                  Rng.Font.Color= -16776961

                                  End If

                                  End If

                                  Next

                                  End Sub

                                    Highlight Specific Text

                                    Giả sử bạn có một tệp dữ liệu lớn và bạn muốn kiểm tra một giá trị cụ thể. Trong trường hợp này, bạn có thể sử dụng mã này. Khi bạn chạy nó, màn hình sẽ hiện input box để bạn nhập giá trị muốn tìm kiếm.

                                    Sub highlightValue()

                                    Dim myStr As String

                                    Dim myRg As Range

                                    Dim myTxt As String

                                    Dim myCell As Range

                                    Dim myChar As String

                                    Dim I As Long

                                    Dim J As Long

                                    On Error Resume Next

                                    myTxt= ActiveWindow.RangeSelection.AddressLocal

                                    Else

                                    myTxt= ActiveSheet.UsedRange.AddressLocal

                                    End If

                                    LInput: Set myRg= Application.InputBox(“please select the data

                                    range:”, “Selection Required”, myTxt, , , , , 8)

                                    If myRg Is Nothing Then

                                    Exit Sub

                                    MsgBox”not support multiple columns” GoToLInput

                                    End If

                                    MsgBox”the selected range can only contain two columns “

                                    GoTo LInput

                                    End If

                                    For I = 0 To myRg.Rows.Count-1

                                    myStr= myRg.Range(“B1”).Offset(I, 0).Value

                                    With myRg.Range(“A1”).Offset(I, 0)

                                    .Font.ColorIndex= 1

                                    For J = 1 To Len(.Text)

                                    Mid(.Text, J, Len(myStr)) = myStrThen

                                    .Characters(J, Len(myStr)).Font.ColorIndex= 3

                                    Next

                                    End With

                                    Next I

                                    End Sub

                                      Highlight Cells with Comments

                                      Sub highlightCommentCells()

                                      Selection.SpecialCells(xlCellTypeComments).Select

                                      Selection.Style= “Note”

                                      End Sub

                                        Highlight Alternate Rows in the Selection

                                        Với việc làm nổi bật các hàng thay thế, bạn có thể dễ dàng đọc dữ liệu hơn. Và vì điều này, bạn có thể sử dụng mã VBA bên dưới. Mã chỉ đơn giản làm nổi bật mỗi hàng thay thế trong phạm vi được chọn.

                                        Sub highlightAlternateRows()

                                        Dim rng As Range

                                        For Each rng In Selection.Rows

                                        If rng.RowMod 2 = 1 Then

                                        rng.Style= “20% -Accent1”

                                        rng.Value= rng^ (1 / 3)

                                        Else

                                        End If

                                        Next rng

                                        End Sub

                                          Highlight Cells with Misspelled Words

                                          Nếu bạn gặp khó khăn trong việc kiểm tra tất cả các hàng về lỗi chính tả thì đây là một mã dành cho bạn. Mã sẽ kiểm tra mỗi ô được chọn và làm nổi bật ô đó khi có lỗi chính tả.

                                          Sub HighlightMisspelledCells()

                                          Dim rng As Range

                                          For Each rng In ActiveSheet.UsedRange

                                          If Not Application.CheckSpelling(word:=rng.Text) Then

                                          rng.Style= “Bad” End If

                                          Next rng

                                          End Sub

                                            Highlight Cells With Error in the Entire Worksheet

                                            Mã này sẽ giúp bạn làm nổi bật và đếm tất cả các ô có lỗi.

                                            Chỉ việc chạy mã này và mã sẽ trả lại một thông báo có số ô lỗi và làm nổi bật tất cả các ô đó.

                                            Sub highlightErrors()

                                            Dim rng As Range

                                            Dim i As Integer

                                            For Each rng In ActiveSheet.UsedRange

                                            If WorksheetFunction.IsError(rng) Then

                                            i = i + 1 rng.Style = “bad”

                                            End If

                                            Next rng

                                            MsgBox “There are total ” & i & ” error(s) in this worksheet.”

                                            End Sub

                                              Highlight Cells with a Specific Text in Worksheet

                                              Mã này sẽ giúp bạn đếm các ô có giá trị cụ thể mà bạn sẽ đề cập và sau đó, mã sẽ làm nổi bật tất cả các ô đó.

                                              Sub highlightSpecificValues()

                                              Dim rng As Range

                                              Dim i As Integer

                                              Dim c As Variant

                                              c = InputBox(“Enter Value To Highlight”)

                                              For Each rng In ActiveSheet.UsedRange

                                              If rng = c Then

                                              rng.Style = “Note”

                                              i = i + 1

                                              End If

                                              Next rng

                                              MsgBox “There are total ” & i &” “& c & ” in this worksheet.”

                                              End Sub

                                                Highlight all the Blank Cells Invisible Space

                                                Đôi khi có những ô trống nhưng chúng có một khoảng trống duy nhất và vì vậy, sẽ rất khó để nhận biết chúng. Mã này sẽ giúp bạn kiểm tra tất cả các ô trong worksheet và làm nổi bật các ô có khoảng trống nhất định.

                                                Sub blankWithSpace()

                                                Dim rng As Range

                                                For Each rng In ActiveSheet.UsedRange

                                                If rng.Value = ” ” Then

                                                rng.Style = “Note”

                                                End If

                                                Next rng

                                                End Sub

                                                  Highlight Max Value In The Range

                                                  Mã này sẽ kiểm tra tất cả các ô được chọn và làm nổi bật ô đó với giá trị lớn nhất.

                                                  Sub highlightMaxValue()

                                                  Dim rng As Range

                                                  For Each rng In Selection

                                                  If rng = WorksheetFunction.Max(Selection) Then

                                                  rng.Style = “Good”

                                                  End If

                                                  Next rng

                                                  End Sub

                                                    Highlight Min Value In The Range

                                                    Mã sẽ kiểm tra tất cả các ô được chọn và làm nổi bật ô đó với giá trị nhỏ nhất.

                                                    Sub highlightMinValue()

                                                    Dim rng As Range

                                                    For Each rng In Selection

                                                    If rng = WorksheetFunction.Min(Selection) Then

                                                    rng.Style = “Good”

                                                    End If

                                                    Next rng

                                                    End Sub

                                                      Highlight Unique Values

                                                      Các mã này sẽ làm nổi bật tất cả các ô được chọn mà có giá trị duy nhất.

                                                      Sub highlightUniqueValues()

                                                      Dim rng As Range

                                                      Set rng = Selection

                                                      rng.FormatConditions.Delete

                                                      Dim uv As UniqueValues

                                                      Set uv = rng.FormatConditions.AddUniqueValues

                                                      uv.DupeUnique = xlUnique

                                                      uv.Interior.Color = vbGreen

                                                      End Sub

                                                        Highlight Difference in Columns

                                                        Sử dụng mã này bạn có thể làm nổi bật sự khác biệt giữa 2 cột (các ô tương ứng).

                                                        Sub columnDifference()

                                                        Range(“H7:H8,I7:I8”).Select

                                                        Selection.ColumnDifferences(ActiveCell).Select

                                                        Selection.Style= “Bad”

                                                        End Sub

                                                          Highlight Difference in Rows

                                                          Sử dụng mã này bạn có thể làm nổi bật sự khác nhau giữa 2 hàng (các ô tương ứng).

                                                          Sub rowDifference()

                                                          Range(“H7:H8,I7:I8”).Select

                                                          Selection.RowDifferences(ActiveCell).Select

                                                          Selection.Style= “Bad”

                                                          End Sub

                                                          Printing Codes

                                                          Những mã macro này sẽ giúp bạn tự động in một số công việc mà có thể tiết kiệm rất nhiều thời gian.

                                                            Print Comments

                                                            Sub printComments()

                                                            With ActiveSheet.PageSetup

                                                            .printComments= xlPrintSheetEnd

                                                            End With

                                                            End Sub

                                                              Print Narrow Margin

                                                              Sử dụng mã VBA này để in giấy có lề hẹp. Khi bạn chạy mã macro này, mã sẽ tự động thay đổi lề thành hẹp.

                                                              Sub printNarrowMargin()

                                                              With ActiveSheet.PageSetup

                                                              .LeftMargin= Application

                                                              .InchesToPoints(0.25)

                                                              .RightMargin= Application.InchesToPoints(0.25)

                                                              .TopMargin= Application.InchesToPoints(0.75)

                                                              .BottomMargin= Application.InchesToPoints(0.75)

                                                              .HeaderMargin= Application.InchesToPoints(0.3)

                                                              .FooterMargin= Application.InchesToPoints(0.3)

                                                              End With

                                                              ActiveWindow.SelectedSheets.PrintOutCopies:=1, Collate:=True,

                                                              IgnorePrintAreas:=False

                                                              End Sub

                                                                Print Selection

                                                                Mã này sẽ giúp bạn in phạm vi được chọn. Bạn không cần phải di chuyển đến mục printing options và cài đặt phạm vi in. bạn chỉ việc chọn một phạm vi và chạy mã này.

                                                                Sub printSelection()

                                                                Selection.PrintOutCopies:=1, Collate:=True

                                                                End Sub

                                                                  Print Custom Pages

                                                                  Thay vì sử dụng cài đặt từ print options, bạn có thể sử dụng mã này để in phạm vi trang điều chỉnh.

                                                                  Ví dụ bạn muốn từ trang 5 đến trang10. Bạn chỉ cần chạy mã VBA này và nhập trang bắt đầu và trang kết thúc.

                                                                  Sub printCustomSelection()

                                                                  Dim startpageAs Integer

                                                                  Dim endpageAs Integer

                                                                  startpage= InputBox(“Please Enter Start Page number.”, “Enter

                                                                  Value”)

                                                                  If Not WorksheetFunction.IsNumber(startpage) Then

                                                                  MsgBox”Invalid Start Page number. Please try again.”, “Error”

                                                                  Exit Sub

                                                                  End If

                                                                  endpage= InputBox(“Please Enter End Page number.”, “Enter

                                                                  Value”)

                                                                  If Not WorksheetFunction.IsNumber(endpage) Then

                                                                  MsgBox”Invalid End Page number. Please try again.”, “Error”

                                                                  Exit Sub

                                                                  End If

                                                                  Selection.PrintOutFrom:=startpage, To:=endpage, Copies:=1,

                                                                  Collate:=True

                                                                  End Sub

                                                                  Worksheet Codes

                                                                  Những mã macro này sẽ giúp bạn kiểm soát và quản lý worksheets theo một cách đơn giản và tiết kiệm rất nhiều thời gian.

                                                                    Hide all but the Active Worksheet

                                                                    Ví dụ bạn muốn ẩn tất cả các worksheets trong workbook của bạn ngoài worksheet đang hoạt động. Mã macro này sẽ giúp bạn làm điều này.

                                                                    Sub HideWorksheet()

                                                                    Dim ws As Worksheet

                                                                    For Each ws In ThisWorkbook.Worksheets

                                                                    ws.Visible = xlSheetHidden

                                                                    End If

                                                                    Next ws

                                                                    End Sub

                                                                      Unhide all Hidden Worksheets

                                                                      Mã này dành cho việc nếu bạn muốn hiển thị tất cả các worksheets mà bạn đã ẩn trong mà trước.                                                                                                                       

                                                                      Sub UnhideAllWorksheet()

                                                                      Dim ws As Worksheet

                                                                      For Each ws In ActiveWorkbook.Worksheets

                                                                      ws.Visible = xlSheetVisible

                                                                      Next ws

                                                                      End Sub

                                                                        Delete all but the Active Worksheet

                                                                        Mã này rất hữu ích cho bạn nếu bạn muốn xóa tất cả các worksheet ngoại trừ sheet đang hoạt động.

                                                                        Khi bạn chạy mã này, mã sẽ so sánh tên workwheet đang hoạt động với các worksheet khác và sau đó xóa chúng.

                                                                        Sub DeleteWorksheets()

                                                                        Dim ws As Worksheet

                                                                        For Each ws In ThisWorkbook.Worksheets

                                                                        Application.DisplayAlerts = False

                                                                        ws.Delete

                                                                        Application.DisplayAlerts = True

                                                                        End If

                                                                        Next ws

                                                                        End Sub

                                                                          Protect all Worksheets Instantly

                                                                          Đây là mã dành cho bạn nếu bạn muốn protect các worksheet chỉ trong một lần.

                                                                          Sub ProtectAllWorskeets()

                                                                          Dim ws As Worksheet

                                                                          Dim ps As String

                                                                          ps = InputBox(“Enter a Password.”, vbOKCancel)

                                                                          For Each ws In ActiveWorkbook.Worksheets

                                                                          ws.Protect Password:=ps

                                                                          Next ws

                                                                          End Sub

                                                                            Resize All Charts in a Worksheet.

                                                                            Tạo các chart có cùng một kích cỡ. mã macro này sẽ giúp bạn tạo tất cả các chart có chung kích cỡ. Bạn có thể thay đổi chiều cao và chiều rộng của chart bằng cách thay đổi nó trong mã macro.

                                                                            Sub Resize_Charts()

                                                                            Dim i As Integer

                                                                            For i = 1 To ActiveSheet.ChartObjects.Count

                                                                            With ActiveSheet.ChartObjects(i)

                                                                            .Width = 300

                                                                            .Height = 200

                                                                            End With

                                                                            Next i

                                                                            End Sub

                                                                              Insert Multiple Worksheets

                                                                              Bạn có thể sử dụng mã này nếu bạn muốn thêm nhiều worksheet trong workbook của bạn chỉ trong một bước.

                                                                              Khi bạn chạy mã macro này, bạn sẽ nhận được input box để nhập tổng số sheet mà bạn muốn nhập.

                                                                              Sub InsertMultipleSheets()

                                                                              Dim i As Integer

                                                                              i = InputBox(“Enter number of sheets to insert.”, “Enter

                                                                              Multiple Sheets”)

                                                                              Sheets.Add After:=ActiveSheet, Count:=i

                                                                              End Sub

                                                                                Protect worksheet

                                                                                Nếu bạn muốn protect worksheet, bạn có thể sử dụng mã này.

                                                                                Bạn chỉ cần nhập password của bạn vào trong mã.

                                                                                Sub ProtectWS()

                                                                                ActiveSheet.Protect “mypassword”, True, True

                                                                                End Sub

                                                                                  Un-Protect Worksheet

                                                                                  Nếu bạn không muốn protect worksheet, bạn có thể sử dụng mà macro này.

                                                                                  Bạn chỉ cần nhập password mà bạn đã sử dụng khi protect worksheet của bạn.

                                                                                  Sub UnprotectWS()

                                                                                  ActiveSheet.Unprotect “mypassword”

                                                                                  End Sub

                                                                                    Sort Worksheets

                                                                                    Mã này sẽ giúp bạn sắp xếp worksheets trong workbook dựa vào tên của worksheet.

                                                                                    Sub SortWorksheets()

                                                                                    Dim i As Integer

                                                                                    Dim j As Integer

                                                                                    Dim iAnswer As VbMsgBoxResult

                                                                                    iAnswer = MsgBox(“Sort Sheets in Ascending Order?” & Chr(10) _

                                                                                    vbYesNoCancel + vbQuestion + vbDefaultButton1, “Sort

                                                                                    Worksheets”)

                                                                                    For i = 1 To Sheets.Count

                                                                                    For j = 1 To Sheets.Count – 1

                                                                                    If iAnswer = vbYes Then

                                                                                    Sheets(j).Move After:=Sheets(j + 1)

                                                                                    End If

                                                                                    ElseIf iAnswer = vbNo Then

                                                                                    If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then

                                                                                    Sheets(j).Move After:=Sheets(j + 1)

                                                                                    End If

                                                                                    End If

                                                                                    Next j

                                                                                    Next i

                                                                                    End Sub          

                                                                                      Protect all the Cells With Formulas

                                                                                      Sub lockCellsWithFormulas()

                                                                                      With ActiveSheet

                                                                                      .Unprotect

                                                                                      .Cells.Locked = False

                                                                                      .Cells.SpecialCells(xlCellTypeFormulas).Locked = True

                                                                                      .Protect AllowDeletingRows:=True

                                                                                      End With

                                                                                      End Sub

                                                                                        Delete all Blank Worksheets

                                                                                        Chạy mã này và mã sẽ kiểm tra tất cả các worksheets trong workbook đang hoạt động và xóa chúng nếu có một worksheet trống.

                                                                                        Sub deleteBlankWorksheets()

                                                                                        Dim Ws As Worksheet

                                                                                        On Error Resume Next

                                                                                        Application.ScreenUpdating= False

                                                                                        Application.DisplayAlerts= False

                                                                                        For Each Ws In Application.Worksheets

                                                                                        If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then

                                                                                        Ws.Delete

                                                                                        End If

                                                                                        Next

                                                                                        Application.ScreenUpdating= True

                                                                                        Application.DisplayAlerts= True

                                                                                        End Sub

                                                                                          Unhide all Rows and Columns

                                                                                          Thay vì hiển thị từng hàng và cột một cách thủ công, bạn có thể sử dụng mã này để thực hiện chỉ trong một bước.

                                                                                          Sub UnhideRowsColumns()

                                                                                          Columns.EntireColumn.Hidden = False

                                                                                          Rows.EntireRow.Hidden = False

                                                                                          End Sub

                                                                                            Save Each Worksheet as a Single PDF

                                                                                            mã này chỉ đơn giản lưu tất cả worksheet vào một tệp PDF riêng. Bạn chỉ cần thay đổi tên tệp từ mã này.

                                                                                            Sub SaveWorkshetAsPDF()

                                                                                            Dimws As Worksheet

                                                                                            For Each ws In Worksheetsws.ExportAsFixedFormat xlTypePDF,

                                                                                            “ENTER-FOLDER-NAME-HERE” & chúng tôi & “.pdf” Nextws

                                                                                            End Sub

                                                                                              Disable Page Breaks

                                                                                              Bạn có thể sử dụng mã này để vô hiệu hóa ngắt trang. Mã đơn giản chỉ vô hiệu hóa ngắt trang từ các workbook đang mở.

                                                                                              Sub DisablePageBreaks()

                                                                                              Dim wbAs Workbook

                                                                                              Dim wksAs Worksheet

                                                                                              Application.ScreenUpdating= False

                                                                                              For Each wbIn Application.Workbooks

                                                                                              For Each ShtIn wb.WorksheetsSht.DisplayPageBreaks= False

                                                                                              Next Sht

                                                                                              Next wb

                                                                                              Application.ScreenUpdating= True

                                                                                              End Sub         

                                                                                              Workbook Codes

                                                                                              Những mã này sẽ giúp bạn thực hiện các công việc workbook một cách đơn giản và không phải tốn nhiều công sức.

                                                                                                Create a Backup of a Current Workbook

                                                                                                Đây là một trong những mã macro hữu ích nhất có thể giúp bạn lưu một tệp hỗ trợ cho workbook của bạn.

                                                                                                Mã sẽ lưu một tệp hỗ trợ trực tiếp với tệp hiện tại được lưu và mã cũng sẽ bổ sung ngày và tên của tệp.

                                                                                                Sub FileBackUp()

                                                                                                ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & _

                                                                                                “” & Format(Date, “mm-dd-yy”) & ” ” & _

                                                                                                ThisWorkbook.name

                                                                                                End Sub

                                                                                                  Close all Workbooks at Once

                                                                                                  Bạn sử dụng mã này để đóng tất cả các workbook đang mở.

                                                                                                  Đầu tiên, mã sẽ kiểm tra từng workbook một và đóng chúng lại. Nếu có bất kỳ worksheet nào chưa được lưu, bạn sẽ nhận được thông báo để lưu.

                                                                                                  Sub CloseAllWorkbooks()

                                                                                                  Dim wbs As Workbook

                                                                                                  For Each wbs In Workbooks

                                                                                                  wbs.Close SaveChanges:=True

                                                                                                  Next wb

                                                                                                  End Sub

                                                                                                    Copy Active Worksheet into a New Workbook

                                                                                                    Ví dụ, nếu bạn muốn sao chép worksheet đang hoạt động vào một workbook mới, bạn chỉ cần chạy mã macro và mã sẽ thực hiện cho bạn.

                                                                                                    Điều này tiết kiệm rất nhiều thời gian.

                                                                                                    Sub CopyWorksheetToNewWorkbook()

                                                                                                    ThisWorkbook.ActiveSheet.Copy _

                                                                                                    Before:=Workbooks.Add.Worksheets(1)

                                                                                                    End Sub

                                                                                                      Active Workbook in an Email

                                                                                                      Sử dụng mã macro này để gửi active workbook của bạn bằng email một cách nhanh chóng.

                                                                                                      Bạn có thể thay đổi tên, email, nội dung trong mã và nếu bạn muốn gửi trực tiếp email này, sử dụng “.Send” thay vì “.Display”.

                                                                                                      Sub Send_Mail()

                                                                                                      Dim OutApp As Object

                                                                                                      Dim OutMail As Object

                                                                                                      Set OutApp = CreateObject(“Outlook.Application”)

                                                                                                      Set OutMail = OutApp.CreateItem(0)

                                                                                                      With OutMail

                                                                                                      .to = “[email protected]

                                                                                                      .Subject = “Growth Report”

                                                                                                      .Body = “Hello Team, Please find attached Growth Report.”

                                                                                                      .Attachments.Add ActiveWorkbook.FullName

                                                                                                      .display

                                                                                                      End With

                                                                                                      Set OutMail = Nothing

                                                                                                      Set OutApp = Nothing

                                                                                                      End Sub

                                                                                                        Add Workbook to a Mail Attachment

                                                                                                        Sau khi chạy mã này, mã sẽ mở ứng dụng thư mặc định của bạn và active workbook sẽ được đính kèm với mail.

                                                                                                        Sub OpenWorkbookAsAttachment()

                                                                                                        Application.Dialogs(xlDialogSendMail).Show

                                                                                                        End Sub

                                                                                                          Welcome Message

                                                                                                          Bạn có thể sử dụng auto_open để thực hiện công việc mở một tệp tin và bạn chỉ cần chỉ định mã macro “auto_open”.

                                                                                                          Sub auto_open()

                                                                                                          MsgBox “Welcome To ExcelChamps & Thanks for downloading this

                                                                                                          file.”

                                                                                                          End Sub

                                                                                                            Closing Message

                                                                                                            Bạn có thể sử dụng close_open để thực hiện công việc mở một tệp tin và bạn chỉ cần chỉ định mã macro “close_open”.

                                                                                                            Sub auto_close()

                                                                                                            MsgBox “Bye Bye! Don’t forget to check other cool stuff on

                                                                                                            excelchamps.com”

                                                                                                            End Sub

                                                                                                              Count Open Unsaved Workbooks

                                                                                                              Ví dụ bạn đang mở 5-10 workbook, bạn có thể sử dụng mã này để biết được số workbook chưa được lưu.

                                                                                                              Sub VisibleWorkbooks()

                                                                                                              Dim book As Workbook

                                                                                                              Dim i As Integer

                                                                                                              For Each book In Workbooks

                                                                                                              If book.Saved = False Then

                                                                                                              i = i + 1

                                                                                                              End If

                                                                                                              Next book

                                                                                                              MsgBox i

                                                                                                              End Sub

                                                                                                              Pivot Table Codes

                                                                                                              Các mã này sẽ giúp bạn quản lý và thực hiện một số thay đổi trong pivot table chỉ trong nháy mắt.

                                                                                                                Hide Pivot Table Subtotals

                                                                                                                Bạn chỉ cần chạy mã này để ẩn tất cả các subtotal.

                                                                                                                Đầu tiên, bạn chọn một ô từ pivot table. Sau đó, thực hiện chạy mã này.

                                                                                                                Sub HideSubtotals()

                                                                                                                Dim pt As PivotTable

                                                                                                                Dim pf As PivotField

                                                                                                                On Error Resume Next

                                                                                                                Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.name)

                                                                                                                If pt Is Nothing Then

                                                                                                                MsgBox “You must place your cursor inside of a PivotTable.”

                                                                                                                Exit Sub

                                                                                                                End If

                                                                                                                For Each pf In pt.PivotFields

                                                                                                                pf.Subtotals(1) = True

                                                                                                                pf.Subtotals(1) = False

                                                                                                                Next pf

                                                                                                                End Sub

                                                                                                                  Refresh All Pivot Tables

                                                                                                                  Đây là một phương pháp để làm mới các pivot table nhanh chóng.

                                                                                                                  Chỉ cần chạy mã này, các pivot table trong workbook của bạn sẽ được làm mới chỉ trong một bước.

                                                                                                                  Sub CloseAllWorkbooks()

                                                                                                                  Dim wbs As Workbook

                                                                                                                  For Each wbs In Workbooks

                                                                                                                  wbs.Close SaveChanges:=True

                                                                                                                  Next wb

                                                                                                                  End Sub

                                                                                                                    Auto Update Pivot Table Range

                                                                                                                    Nếu bạn không sử dụng các bảng Excel, bạn có thể sử dụng mã này để nâng cấp phạm vi pivot table.

                                                                                                                    Sub UpdatePivotTableRange()

                                                                                                                    Dim Data_Sheet As Worksheet

                                                                                                                    Dim Pivot_Sheet As Worksheet

                                                                                                                    Dim StartPoint As Range

                                                                                                                    Dim DataRange As Range

                                                                                                                    Dim PivotName As String

                                                                                                                    Dim NewRange As String

                                                                                                                    Dim LastCol As Long

                                                                                                                    Dim lastRow As Long

                                                                                                                    ‘Set Pivot Table & Source Worksheet

                                                                                                                    Set Data_Sheet = ThisWorkbook.Worksheets(“PivotTableData3”)

                                                                                                                    Set Pivot_Sheet = ThisWorkbook.Worksheets(“Pivot3”)

                                                                                                                    ‘Enter in Pivot Table Name

                                                                                                                    PivotName = “PivotTable2”

                                                                                                                    ‘Defining Staring Point & Dynamic Range

                                                                                                                    Data_Sheet.Activate

                                                                                                                    Set StartPoint = Data_Sheet.Range(“A1”)

                                                                                                                    LastCol = StartPoint.End(xlToRight).Column

                                                                                                                    DownCell = StartPoint.End(xlDown).Row

                                                                                                                    Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))

                                                                                                                    NewRange = Data_Sheet.Name & “!” & DataRange.Address(ReferenceStyle:=xlR1C1)

                                                                                                                    ‘Change Pivot Table Data Source Range Address

                                                                                                                    Pivot_Sheet.PivotTables(PivotName). _

                                                                                                                    ChangePivotCache ActiveWorkbook. _

                                                                                                                    PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)

                                                                                                                    ‘Ensure Pivot Table is Refreshed

                                                                                                                    Pivot_Sheet.PivotTables(PivotName).RefreshTable

                                                                                                                    ‘Complete Message

                                                                                                                    Pivot_Sheet.Activate

                                                                                                                    MsgBox “Your Pivot Table is now updated.”

                                                                                                                    End Sub

                                                                                                                      Disable/Enable Get Pivot Data

                                                                                                                      Để vô hiệu hóa/kích hoạt chức năng GetPivotData, bạn cần sử dụng Excel option.

                                                                                                                      Sub activateGetPivotData()

                                                                                                                      Application.GenerateGetPivotData = True

                                                                                                                      End Sub

                                                                                                                      Sub deactivateGetPivotData()

                                                                                                                      Application.GenerateGetPivotData = False

                                                                                                                      End Sub

                                                                                                                      Charts Codes

                                                                                                                      Sử dụng những mã VBA này để quản lý charts trong Excel và tiết kiệm được nhiều thời gian của bạn.

                                                                                                                        Change Chart Type

                                                                                                                        Mã này sẽ giúp bạn chuyển đổi loại chart mà cần phải sử dụng các chart option từ tab.

                                                                                                                        Bạn chỉ cần chỉ rõ loại chart nào mà bạn muốn chuyển đổi.

                                                                                                                        Mã bên dưới sẽ được chọn chuyển đổi đến một column chart được tập hợp.

                                                                                                                        Có nhiều mã code khác nhau dành cho các loại chart khác nhau, bạn có thể tìm thấy các loại đó ở đây.

                                                                                                                        Sub ChangeChartType()

                                                                                                                        ActiveChart.ChartType = xlColumnClustered

                                                                                                                        End Sub

                                                                                                                          Paste Chart as an Image

                                                                                                                          Mã này sẽ giúp bạn chuyển đổi chart sang hình ảnh.

                                                                                                                          Bạn chỉ cần chọn chart và chạy mã này.

                                                                                                                          Sub ConvertChartToPicture()

                                                                                                                          ActiveChart.ChartArea.Copy

                                                                                                                          ActiveSheet.Range(“A1”).Select

                                                                                                                          ActiveSheet.Pictures.Paste.Select

                                                                                                                          End Sub

                                                                                                                            Add Chart Title

                                                                                                                            Đầu tiên, bạn cần phải chọn chart và chạy mã này.

                                                                                                                            Bạn sẽ nhận được một input box để nhập tiêu đề chart.

                                                                                                                            Sub AddChartTitle()

                                                                                                                            Dim i As Variant

                                                                                                                            i = InputBox(“Please enter your chart title”, “Chart Title”)

                                                                                                                            On Error GoTo Last

                                                                                                                            ActiveChart.SetElement (msoElementChartTitleAboveChart)

                                                                                                                            ActiveChart.ChartTitle.Text = i

                                                                                                                            Last:

                                                                                                                            Exit Sub

                                                                                                                            End Sub

                                                                                                                            Advanced Codes

                                                                                                                              Save Selected Range as a PDF

                                                                                                                              Nếu bạn muốn ẩn tất cả các subtotal, chỉ cần chạy mã này.

                                                                                                                              Đầu tiên, bạn chọn một ô từ pivot table. Sau đó, thực hiện chạy mã này.

                                                                                                                              Sub HideSubtotals()

                                                                                                                              Dim pt As PivotTable

                                                                                                                              Dim pf As PivotField

                                                                                                                              On Error Resume Next

                                                                                                                              Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.n ame)

                                                                                                                              If pt Is Nothing Then

                                                                                                                              MsgBox “You must place your cursor inside of a PivotTable.”

                                                                                                                              Exit Sub

                                                                                                                              End If

                                                                                                                              For Each pf In pt.PivotFields

                                                                                                                              pf.Subtotals(1) = True

                                                                                                                              pf.Subtotals(1) = False

                                                                                                                              Next pf

                                                                                                                              End Sub

                                                                                                                                Create a Table of Content

                                                                                                                                Ví dụ bạn có hơn 100 worksheet trong workbook và rất khó để navigate.

                                                                                                                                Khi bạn chạy mã này, mã sẽ tạo một worksheet mới và tạo một chỉ số worksheet với một hyperlink dẫn tới những worksheet đó.

                                                                                                                                Sub TableofContent()

                                                                                                                                Dim i As Long

                                                                                                                                On Error Resume Next

                                                                                                                                Application.DisplayAlerts = False

                                                                                                                                Worksheets(“Table of Content”).Delete

                                                                                                                                Application.DisplayAlerts = True

                                                                                                                                On Error GoTo 0

                                                                                                                                ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)

                                                                                                                                ActiveSheet.Name = “Table of Content”

                                                                                                                                For i = 1 To Sheets.Count

                                                                                                                                With ActiveSheet

                                                                                                                                .Hyperlinks.Add _

                                                                                                                                Anchor:=ActiveSheet.Cells(i, 1), _

                                                                                                                                Address:=””, _

                                                                                                                                SubAddress:=”‘” & Sheets(i).Name & “‘!A1”, _

                                                                                                                                ScreenTip:=Sheets(i).Name, _

                                                                                                                                TextToDisplay:=Sheets(i).Name

                                                                                                                                End With

                                                                                                                                Next i

                                                                                                                                End Sub

                                                                                                                                  Convert Range into an Image

                                                                                                                                  Dán phạm vi được chọn như một hình ảnh.

                                                                                                                                  Bạn chỉ cần chọn phạm vi và sau khi bạn chạy mã này, mã sẽ tự động chèn một hình ảnh cho phạm vi đó.

                                                                                                                                  Sub PasteAsPicture()

                                                                                                                                  Application.CutCopyMode = False

                                                                                                                                  Selection.Copy

                                                                                                                                  ActiveSheet.Pictures.Paste.Select

                                                                                                                                  End Sub

                                                                                                                                    Insert a Linked Picture

                                                                                                                                    Mã VBA này sẽ chuyển đổi phạm vi được chọn của bạn sang một hình ảnh được liên kết và bạn có thể sử dụng hình ảnh này bất cứ nơi đâu bạn muốn.

                                                                                                                                    Sub LinkedPicture()

                                                                                                                                    Selection.Copy

                                                                                                                                    ActiveSheet.Pictures.Paste(Link:=True).Select

                                                                                                                                    End Sub

                                                                                                                                      Use Text to Speech

                                                                                                                                      Chọn một phạm vi và chạy mã này.

                                                                                                                                      Excel sẽ đọc các văn bản của từng ô một mà bạn có trong phạm vi.

                                                                                                                                      Sub Speak()

                                                                                                                                      Selection.Speak

                                                                                                                                      End Sub

                                                                                                                                        Activate Data Entry Form

                                                                                                                                        Đây là một mẫu nhập dữ liệu mặc định mà bạn có thể sử dụng để nhập dữ liệu.

                                                                                                                                        Sub DataForm()

                                                                                                                                        ActiveSheet.ShowDataForm

                                                                                                                                        End Sub

                                                                                                                                          Use Goal Seek

                                                                                                                                          Goal Seek có thể rất hữu ích cho bạn để giải quyết các vấn đề phức tạp.

                                                                                                                                          Tìm hiểu thêm các thông tin về goal seek ở đây trước khi sử dụng mã này.

                                                                                                                                          Sub GoalSeekVBA()

                                                                                                                                          Dim Target As Long

                                                                                                                                          On Error GoTo Errorhandler

                                                                                                                                          Target = InputBox(“Enter the required value”, “Enter Value”)

                                                                                                                                          Worksheets(“Goal_Seek”).Activate

                                                                                                                                          With ActiveSheet .Range(“C7”)

                                                                                                                                          .GoalSeek_ Goal:=Target, _

                                                                                                                                          ChangingCell:=Range(“C2”)

                                                                                                                                          End With

                                                                                                                                          Exit Sub

                                                                                                                                          Errorhandler: MsgBox(“Sorry, value is not valid.”)

                                                                                                                                          End Sub

                                                                                                                                            VBA Code to Search on Google

                                                                                                                                            Thực hiện theo post này để biết thêm cách sử dụng mã VBA này để tìm kiếm trên Google.

                                                                                                                                            Sub SearchWindow32()

                                                                                                                                            Dim chromePath As String

                                                                                                                                            Dim search_string As String

                                                                                                                                            Dim query As String

                                                                                                                                            query = InputBox(“Enter here your search here”, “Google Search”)

                                                                                                                                            search_string = query

                                                                                                                                            search_string = Replace(search_string, ” “, “+”)

                                                                                                                                            chromePath = “C:Program

                                                                                                                                            FilesGoogleChromeApplicationchrome.exe”

                                                                                                                                            chromePath = “C:Program Files

                                                                                                                                            (x86)GoogleChromeApplicationchrome.exe”

                                                                                                                                            Shell (chromePath & ” -url http://google.com/#q=” & search_string)

                                                                                                                                            End Sub

                                                                                                                                            Formula Codes

                                                                                                                                            Các mã này sẽ giúp bạn tính toán và đưa ra kết quả mà bạn thường phải làm với worksheet functions và formulas.

                                                                                                                                               Convert all Formulas into Values

                                                                                                                                              Đơn giản chỉ là chuyển đổi các formulas sang values.

                                                                                                                                              Khi bạn chạy mã macro này, mã sẽ thay đổi các formulas sang các absolute values.

                                                                                                                                              Sub ConvertToValues()

                                                                                                                                              Dim MyRange As Range

                                                                                                                                              Dim MyCell As Range

                                                                                                                                              Select Case MsgBox(“You Can’t Undo This Action. ” & “Save

                                                                                                                                              Workbook First?”, vbYesNoCancel, “Alert”)

                                                                                                                                              Case Is = vbYes

                                                                                                                                              ThisWorkbook.Save

                                                                                                                                              Case Is = vbCancel

                                                                                                                                              Exit Sub

                                                                                                                                              End Select

                                                                                                                                              Set MyRange = Selection

                                                                                                                                              For Each MyCell In MyRange

                                                                                                                                              If MyCell.HasFormula Then

                                                                                                                                              MyCell.Formula = MyCell.Value

                                                                                                                                              End If

                                                                                                                                              Next MyCell

                                                                                                                                              End Sub

                                                                                                                                                Remove Spaces from Selected Cells

                                                                                                                                                Đây là một trong những mã macro hữu ích nhât trong danh sách này.

                                                                                                                                                Mã sẽ kiểm tra selection của bạn và sau đó xóa tất cả khoảng trắng từ selection đó.

                                                                                                                                                Sub RemoveSpaces()

                                                                                                                                                Dim myRange As Range

                                                                                                                                                Dim myCell As Range

                                                                                                                                                Select Case MsgBox(“You Can’t Undo This Action. ” & “Save

                                                                                                                                                Workbook First?”, _

                                                                                                                                                vbYesNoCancel, “Alert”)

                                                                                                                                                Case Is = vbYesThisWorkbook.Save

                                                                                                                                                Case Is = vbCancel

                                                                                                                                                Exit Sub

                                                                                                                                                End Select

                                                                                                                                                Set myRange = Selection

                                                                                                                                                For Each myCell In myRange

                                                                                                                                                If Not IsEmpty(myCell) Then

                                                                                                                                                myCell = Trim(myCell)

                                                                                                                                                End If

                                                                                                                                                Next myCell

                                                                                                                                                End Sub

                                                                                                                                                  Remove Characters from a String

                                                                                                                                                  Đơn giản là xóa các ký tự từ đầu chuỗi văn bản.

                                                                                                                                                  Bạn chỉ cần tham khảo một ô hoặc chèn một văn bản vào function và số ký tự sẽ bị xóa từ đầu chuỗi văn bản.

                                                                                                                                                  Mã có 2 argument “rng” cho chuỗi văn bản và “cnt” cho việc đếm các ký tự để xóa bỏ.

                                                                                                                                                  Ví dụ: Nếu bạn muốn xóa ký tự đầu tiên từ một cột, bạn chỉ cần nhập 1 vào cnt.

                                                                                                                                                  Public Function removeFirstC(rng As String, cnt As Long)

                                                                                                                                                  removeFirstC = Right(rng, Len(rng) – cnt)

                                                                                                                                                  End Function

                                                                                                                                                    Add Insert Degree Symbol in Excel

                                                                                                                                                    Ví dụ bạn có một danh sách các số trong một cột và bạn muốn thêm degree symbol vào chúng.

                                                                                                                                                    Sub degreeSymbol( )

                                                                                                                                                    Dim rng As Range

                                                                                                                                                    For Each rng In Selection

                                                                                                                                                    rng.Select

                                                                                                                                                    If IsNumeric(ActiveCell.Value) Then

                                                                                                                                                    ActiveCell.Value = ActiveCell.Value & “°”

                                                                                                                                                    End If

                                                                                                                                                    End If

                                                                                                                                                    Next

                                                                                                                                                    End Sub

                                                                                                                                                      Reverse Text

                                                                                                                                                      Bạn chỉ cần nhập chức năng “rvrse” vào một ô và chuyển đến ô có văn bản mà bạn muốn đảo ngược.

                                                                                                                                                      Public Function rvrse(ByVal cell As Range) As String

                                                                                                                                                      rvrse = VBA.strReverse(cell.Value)

                                                                                                                                                      End Function

                                                                                                                                                        Activate R1C1 Reference Style

                                                                                                                                                        Mã macro này sẽ giúp bạn kích hoạt R1C1 reference style mà không phải sử dụng Excel options.

                                                                                                                                                        Sub DataForm()

                                                                                                                                                        ActiveSheet.ShowDataForm

                                                                                                                                                        End Sub

                                                                                                                                                          Activate A1 Reference Style

                                                                                                                                                          Mã macro này sẽ giúp bạn kích hoạt A1 reference style mà không cần phải sử dụng Excel options.

                                                                                                                                                          Sub ActivateA1()

                                                                                                                                                          If Application.ReferenceStyle = xlR1C1 Then

                                                                                                                                                          Application.ReferenceStyle = xlA1

                                                                                                                                                          Else

                                                                                                                                                          Application.ReferenceStyle = xlA1

                                                                                                                                                          End If

                                                                                                                                                          End Sub

                                                                                                                                                            Insert Time Range

                                                                                                                                                            Với mã này, bạn có thể chèn phạm vi thời gian theo thứ tự từ 00:00 đến 23:00.

                                                                                                                                                            Sub TimeStamp()

                                                                                                                                                            Dim i As Integer

                                                                                                                                                            For i = 1 To 24

                                                                                                                                                            ActiveCell.FormulaR1C1 = i & “:00”

                                                                                                                                                            ActiveCell.NumberFormat = “[$-409]h:mm AM/PM;@”

                                                                                                                                                            ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select

                                                                                                                                                            Next i

                                                                                                                                                            End Sub

                                                                                                                                                              Convert Date into Day

                                                                                                                                                              Nếu trong worksheet của bạn có dates và bạn muốn chuyển đổi tất cả các dates sang days. Bạn có thể sử dụng mã này.

                                                                                                                                                              Đơn giản chỉ cần chọn phạm vi các ô và chạy mã này.

                                                                                                                                                              Sub date2day()

                                                                                                                                                              Dim tempCell As Range

                                                                                                                                                              Selection.Value = Selection.Value

                                                                                                                                                              For Each tempCell In Selection

                                                                                                                                                              If IsDate(tempCell) = True Then

                                                                                                                                                              With tempCell

                                                                                                                                                              .Value = Day(tempCell)

                                                                                                                                                              .NumberFormat = “0”

                                                                                                                                                              End With

                                                                                                                                                              End If

                                                                                                                                                              Next tempCell

                                                                                                                                                              End Sub

                                                                                                                                                                Convert Date into Year

                                                                                                                                                                Mã này sẽ chuyển đổi ngày sang năm.

                                                                                                                                                                Sub date2year()

                                                                                                                                                                Dim tempCell As Range

                                                                                                                                                                Selection.Value = Selection.Value

                                                                                                                                                                For Each tempCell In Selection

                                                                                                                                                                If IsDate(tempCell) = True Then

                                                                                                                                                                With tempCell

                                                                                                                                                                .Value = Year(tempCell)

                                                                                                                                                                .NumberFormat = “0”

                                                                                                                                                                End With

                                                                                                                                                                End If

                                                                                                                                                                Next tempCell

                                                                                                                                                                End Sub

                                                                                                                                                                  Remove Time from Date

                                                                                                                                                                  Bạn có thể sử dụng mã này nếu trong worksheet có hiển thị thời gian cùng với ngày và bạn muốn xóa thời gian đi.

                                                                                                                                                                  Sub removeTime()

                                                                                                                                                                  Dim Rng As Range

                                                                                                                                                                  For Each Rng In Selection

                                                                                                                                                                  If IsDate(Rng) = True Then

                                                                                                                                                                  Rng.Value = VBA.Int(Rng.Value)

                                                                                                                                                                  End If

                                                                                                                                                                  Next

                                                                                                                                                                  Selection.NumberFormat = “dd-mmm-yy”

                                                                                                                                                                  End Sub

                                                                                                                                                                    Remove Date from Date and Time

                                                                                                                                                                    Mã sẽ trả lại duy nhất thời gian khỏi giá trị ngày và thời gian.

                                                                                                                                                                    Sub removeDate()

                                                                                                                                                                    Dim Rng As Range

                                                                                                                                                                    For Each Rng In Selection

                                                                                                                                                                    If IsDate(Rng) = True Then

                                                                                                                                                                    Rng.Value = Rng.Value – VBA.Fix(Rng.Value)

                                                                                                                                                                    End If

                                                                                                                                                                    NextSelection.NumberFormat = “hh:mm:ss am/pm”

                                                                                                                                                                    End Sub

                                                                                                                                                                      Convert to Upper Case

                                                                                                                                                                      Chọn các ô và chạy mã này.

                                                                                                                                                                      Mã sẽ kiểm tra mỗi một ô của phạm vi được chọn và sau đó chuyển đổi chúng sang văn bản chữ hoa.

                                                                                                                                                                      Sub convertUpperCase()

                                                                                                                                                                      Dim Rng As Range

                                                                                                                                                                      For Each Rng In Selection

                                                                                                                                                                      If Application.WorksheetFunction.IsText(Rng) Then

                                                                                                                                                                      Rng.Value = UCase(Rng)

                                                                                                                                                                      End If

                                                                                                                                                                      Next

                                                                                                                                                                      End Sub

                                                                                                                                                                        Convert to Lower Case

                                                                                                                                                                        Mã này sẽ giúp bạn chuyển đổi văn bản được chọn sang văn bản chữ thường.

                                                                                                                                                                        Chỉ cần chọn một phạm vi các ô có văn bản và chạy mã này.

                                                                                                                                                                        Nếu một ô có 1 số hoặc bất kỳ giá trị nào không phải là văn bản thì giá trị đó sẽ được giữ lại.

                                                                                                                                                                        Sub convertLowerCase()

                                                                                                                                                                        Dim Rng As Range

                                                                                                                                                                        For Each Rng In Selection

                                                                                                                                                                        If Application.WorksheetFunction.IsText(Rng) Then

                                                                                                                                                                        Rng.Value= LCase(Rng)

                                                                                                                                                                        End If

                                                                                                                                                                        Next

                                                                                                                                                                        End Sub

                                                                                                                                                                          Convert to Proper Case

                                                                                                                                                                          Mã này sẽ chuyền đổi văn bản được chọn sang tên riêng mà có chữ cái đầu được viết hoa và phần còn lại được viết thường.

                                                                                                                                                                          Sub convertProperCase()

                                                                                                                                                                          Dim Rng As Range

                                                                                                                                                                          For Each Rng In Selection

                                                                                                                                                                          If WorksheetFunction.IsText(Rng) Then

                                                                                                                                                                          Rng.Value= WorksheetFunction.Proper(Rng.Value)

                                                                                                                                                                          End If

                                                                                                                                                                          Next

                                                                                                                                                                          End Sub

                                                                                                                                                                            Convert to Sentence Case

                                                                                                                                                                            Trong trường hợp văn bản, từ đầu tiên có chữ cái đầu viết hoa và phần còn lại viết thường trong mỗi câu thì mã này sẽ giúp bạn chuyển đổi văn bản thường thành câu có chữ cái đầu được viết hoa.

                                                                                                                                                                            Sub convertTextCase()

                                                                                                                                                                            Dim Rng As Range

                                                                                                                                                                            For Each Rng In Selection

                                                                                                                                                                            If WorksheetFunction.IsText(Rng) Then

                                                                                                                                                                            Rng.Value= UCase(Left(Rng, 1)) & LCase(Right(Rng, Len(Rng) -1))

                                                                                                                                                                            End If

                                                                                                                                                                            Next rng

                                                                                                                                                                            End Sub

                                                                                                                                                                              Remove a Character form Selection

                                                                                                                                                                              Bạn có thể sử dụng mã này để xóa một ký tự cụ thể từ ô được chọn.

                                                                                                                                                                              Mã sẽ hiển thị một input box để nhập ký tự mà bạn muốn xóa.

                                                                                                                                                                              Sub removeChar()

                                                                                                                                                                              Dim Rng As Range

                                                                                                                                                                              Dim rc As String

                                                                                                                                                                              rc = InputBox(“Character(s) to Replace”, “Enter Value”)

                                                                                                                                                                              For Each Rng In Selection

                                                                                                                                                                              Selection.Replace What:=rc, Replacement:=””

                                                                                                                                                                              Next

                                                                                                                                                                              End Sub

                                                                                                                                                                                Word Count from Entire Worksheet

                                                                                                                                                                                Mã có thể giúp bạn đếm tất cả các từ trong một worksheet.

                                                                                                                                                                                Sub Word_Count_Worksheet()

                                                                                                                                                                                Dim WordCnt As Long

                                                                                                                                                                                Dim rng As Range

                                                                                                                                                                                Dim S As String

                                                                                                                                                                                Dim N As Long

                                                                                                                                                                                For Each rng In ActiveSheet.UsedRange.Cells

                                                                                                                                                                                S = Application.WorksheetFunction.Trim(rng.Text)

                                                                                                                                                                                N = 0

                                                                                                                                                                                N = Len(S) – Len(Replace(S, ” “, “”)) + 1

                                                                                                                                                                                End If

                                                                                                                                                                                WordCnt = WordCnt + N

                                                                                                                                                                                Next rng

                                                                                                                                                                                MsgBox “There are total ” & Format(WordCnt, “#,##0″) & ” words

                                                                                                                                                                                in the active worksheet”

                                                                                                                                                                                End Sub

                                                                                                                                                                                  Remove the Apostrophe from a Number

                                                                                                                                                                                  Nếu bạn có dữ liệu bằng số mà có dấu móc lửng trước mỗi số, bạn có thể chạy mã này để xóa chúng.

                                                                                                                                                                                  Sub removeApostrophes()

                                                                                                                                                                                  Selection.Value = Selection.Value

                                                                                                                                                                                  End Sub

                                                                                                                                                                                    Remove Decimals from Numbers

                                                                                                                                                                                    Mã này chỉ đơn giản giúp bạn xóa tất cả các phân số thập phân khỏi các số từ phạm vi được chọn.

                                                                                                                                                                                    Sub removeDecimals()

                                                                                                                                                                                    Dim lnumber As Double

                                                                                                                                                                                    Dim lResult As Long

                                                                                                                                                                                    Dim rng As Range

                                                                                                                                                                                    For Each rng In Selection

                                                                                                                                                                                    rng.Value= Int(rng)

                                                                                                                                                                                    rng.NumberFormat= “0”

                                                                                                                                                                                    Next rng

                                                                                                                                                                                    End Sub

                                                                                                                                                                                      Multiply all the Values by a Number

                                                                                                                                                                                      Ví dụ bạn có một danh sách các số và bạn muốn nhân tất cả các số với một số cụ thể.

                                                                                                                                                                                      Hãy sử dụng mã này.

                                                                                                                                                                                      Chọn một phạm vi các ô và chạy mã này. Đầu tiên mã sẽ yêu cầu bạn nhập số mà bạn muốn nhân và sau đó ngay lập tức nhân tất cả các số trong ô với số đó.

                                                                                                                                                                                      Sub multiplyWithNumber()

                                                                                                                                                                                      Dim rng As Range

                                                                                                                                                                                      Dim c As Integer c = InputBox(“Enter number to multiple”,

                                                                                                                                                                                      “Input Required”)

                                                                                                                                                                                      For Each rng In Selection

                                                                                                                                                                                      If WorksheetFunction.IsNumber(rng) Then

                                                                                                                                                                                      rng.Value = rng * c

                                                                                                                                                                                      Else

                                                                                                                                                                                      End If

                                                                                                                                                                                      Next rng

                                                                                                                                                                                      End Sub

                                                                                                                                                                                        Add a Number in all the Numbers

                                                                                                                                                                                        Giống như việc nhân lên, bạn cũng có thể thêm một số vào một bộ số.

                                                                                                                                                                                        Sub addNumber()

                                                                                                                                                                                        Dim rngAs Range

                                                                                                                                                                                        DimiAs Integer

                                                                                                                                                                                        i= InputBox(“Enter number to multiple”, “Input Required”)

                                                                                                                                                                                        For Each rng In Selection

                                                                                                                                                                                        If WorksheetFunction.IsNumber(rng) Then

                                                                                                                                                                                        rng.Value= rng+ i

                                                                                                                                                                                        Else

                                                                                                                                                                                        End If

                                                                                                                                                                                        Next rng

                                                                                                                                                                                        End Sub

                                                                                                                                                                                          Calculate the Square Root

                                                                                                                                                                                          Bạn có thể sử dụng mã này để tính số căn bình phương mà không cần áp dụng công thức.

                                                                                                                                                                                          Mã sẽ kiểm tra tất cả các ô được chọn và chuyển đổi các số thành căn bình phương của chúng.

                                                                                                                                                                                          Sub getSquareRoot()

                                                                                                                                                                                          Dim rngAs Range

                                                                                                                                                                                          Dim i As Integer

                                                                                                                                                                                          For Each rng In Selection

                                                                                                                                                                                          If WorksheetFunction.IsNumber(rng) Then

                                                                                                                                                                                          rng.Value= Sqr(rng)

                                                                                                                                                                                          Else

                                                                                                                                                                                          End If

                                                                                                                                                                                          Next rng

                                                                                                                                                                                          End Sub

                                                                                                                                                                                            Calculate the Cube Root

                                                                                                                                                                                            Bạn có thể sử dụng mã này để tính căn bậc ba mà không phải áp dụng công thức.

                                                                                                                                                                                            Mã sẽ kiểm tra tất cả các ô được chọn và chuyển đổi các số thành căn bậc ba của chúng.

                                                                                                                                                                                            Sub getCubeRoot()

                                                                                                                                                                                            Dim rng As Range

                                                                                                                                                                                            Dimi As Integer

                                                                                                                                                                                            For Each rng In Selection

                                                                                                                                                                                            If WorksheetFunction.IsNumber(rng) Then

                                                                                                                                                                                            rng.Value = rng ^ (1 / 3)

                                                                                                                                                                                            Else

                                                                                                                                                                                            End If

                                                                                                                                                                                            Nextrng

                                                                                                                                                                                            End Sub

                                                                                                                                                                                              Add A-Z Alphabets in a Range

                                                                                                                                                                                              Cũng giống như các dãy số, bạn cũng có thể chèn các chữ cái vào worksheet.

                                                                                                                                                                                              Sub addcAlphabets()

                                                                                                                                                                                              Dim i As Integer

                                                                                                                                                                                              For i= 65 To 90

                                                                                                                                                                                              ActiveCell.Value= Chr(i)

                                                                                                                                                                                              ActiveCell.Offset(1, 0).Select

                                                                                                                                                                                              Next i

                                                                                                                                                                                              End Sub

                                                                                                                                                                                              Sub addsAlphabets()

                                                                                                                                                                                              Dim i As Integer

                                                                                                                                                                                              For i= 97 To 122

                                                                                                                                                                                              ActiveCell.Value= Chr(i)

                                                                                                                                                                                              ActiveCell.Offset(1, 0).Select

                                                                                                                                                                                              Next i

                                                                                                                                                                                              End Sub

                                                                                                                                                                                                Convert Roman Numbers into Arabic Numbers

                                                                                                                                                                                                Đôi khi, rất khó để nhận biết số La Mã là số seri. Mã này sẽ giúp bạn chuyển đổi số La Mã sang số Arabic.

                                                                                                                                                                                                Sub convertToNumbers()

                                                                                                                                                                                                Dim rng As Range

                                                                                                                                                                                                Selection.Value= Selection.Value

                                                                                                                                                                                                For Each rng In Selection

                                                                                                                                                                                                If Not WorksheetFunction.IsNonText(rng) Then

                                                                                                                                                                                                rng.Value= WorksheetFunction.Arabic(rng)

                                                                                                                                                                                                End If

                                                                                                                                                                                                Next rng

                                                                                                                                                                                                End Sub

                                                                                                                                                                                                  Remove Negative Signs

                                                                                                                                                                                                  Mã này sẽ kiểm tra các ô được chọn và chuyển đổi các số âm sang số dương. Bạn chỉ cần chọn một phạm vi và chạy mã này.

                                                                                                                                                                                                  Sub removeNegativeSign()

                                                                                                                                                                                                  Dim rngAs Range

                                                                                                                                                                                                  Selection.Value= Selection.Value

                                                                                                                                                                                                  For Each rngIn Selection

                                                                                                                                                                                                  If WorksheetFunction.IsNumber(rng)

                                                                                                                                                                                                  Then rng.Value= Abs(rng)

                                                                                                                                                                                                  End If

                                                                                                                                                                                                  Next rng

                                                                                                                                                                                                  End Sub

                                                                                                                                                                                                    Replace Blank Cells with Zeros

                                                                                                                                                                                                    Sub replaceBlankWithZero()

                                                                                                                                                                                                    Dim rngAs Range

                                                                                                                                                                                                    Selection.Value= Selection.Value

                                                                                                                                                                                                    For Each rngIn Selection

                                                                                                                                                                                                    If rng= “” Or rng= ” ” Then

                                                                                                                                                                                                    rng.Value= “0”

                                                                                                                                                                                                    Else

                                                                                                                                                                                                    End If

                                                                                                                                                                                                    Next rng

                                                                                                                                                                                                    End Sub

                                                                                                                                                                                                    Theo: Excel Champ