Przykłady VBA

Przykłady Excel VBA dla początkujących

Makra są najlepszym przyjacielem, jeśli chodzi o zwiększenie produktywności lub zaoszczędzenie czasu w miejscu pracy. Od małych zadań po duże zadania możemy zautomatyzować za pomocą języka kodowania VBA. Wiem, że często mogłeś pomyśleć o niektórych ograniczeniach programu Excel, ale dzięki kodowaniu VBA możesz je wszystkie wyeliminować. Ok, jeśli zmagałeś się z VBA i nadal jesteś początkującym w tym artykule, podamy kilka przydatnych przykładów kodu makr VBA w Excelu.

Lista 19 najlepszych przykładów

  1. Drukuj wszystkie nazwy arkuszy
  2. Wstaw inny indeks kolorów w VBA
  3. Wstaw numer seryjny od góry
  4. Wstaw numer seryjny od dołu
  5. Wstaw numer seryjny od 10 do 1
  6. Wstawianie arkuszy roboczych tyle, ile chcesz
  7. Usuń wszystkie puste arkusze ze skoroszytu
  8. Wstaw pusty wiersz po każdym innym wierszu
  9. Wyróżnij błąd w pisowni
  10. Zmień wszystko na wielkie litery
  11. Zmień wszystko na małe litery
  12. Podświetl wszystkie skomentowane komórki
  13. Podświetl wszystkie puste komórki
  14. Ukryj wszystkie arkusze z wyjątkiem jednego arkusza
  15. Odkryj wszystkie arkusze
  16. Usuń wszystkie pliki w folderze
  17. Usuń cały folder
  18. Znajdź ostatni używany wiersz w arkuszu
  19. Znajdź ostatnio używaną kolumnę w arkuszu

Zobaczmy szczegółowo każdy z tego przykładu.

Możesz pobrać ten szablon Excel z przykładami VBA tutaj - szablon Excel z przykładami VBA

# 1 - Wydrukuj wszystkie nazwy arkuszy

Kod:

 Sub Print_Sheet_Names () Dim i As Integer For i = 1 To Sheets.Count Cells (i, 1) .Value = Sheets (i). Name Next i End Sub

Spowoduje to wyodrębnienie wszystkich nazw arkuszy do aktywnego arkusza.

# 2 - Wstaw inny indeks kolorów w VBA

Kod:

 Sub Insert_Different_Colours () Dim i As Integer For i = 1 to 56 Cells (i, 1) .Value = i Cells (i, 2) .Interior.ColorIndex = i Next End Sub

Spowoduje to wstawienie liczb od 1 do 56 i ich indeksu koloru w następnej kolumnie.

# 3 - Wstaw numer seryjny od góry

Kod:

 Sub Insert_Numbers_From_Top () Dim i As Integer For i = 1 to 10 Cells (i, 1) .Value = i Next i End Sub

Spowoduje to wstawienie numerów seryjnych od 1 do 10 od góry.

# 4 - Wstaw numer seryjny od dołu

Kod:

 Sub Insert_Numbers_From_Bottom () Dim i As Integer For i = 20 To 1 Step -1 Cells (i, 7). Value = i Next i End Sub

Spowoduje to wstawienie numerów seryjnych od 1 do 20 od dołu.

# 5 - Wstaw numer seryjny od 10 do 1

Kod:

 Sub Ten_To_One () Dim i As Integer Dim j As Integer j = 10 For i = 1 to 10 Range ("A" & i). Wartość = jj = j - 1 Next i End Sub

Spowoduje to wstawienie numerów seryjnych od 10 do 1 od góry.

# 6 - Wstawianie arkuszy roboczych tyle, ile chcesz

Kod:

 Sub AddSheets () Dim ShtCount As Integer, i As Integer ShtCount = Application.InputBox ("Ile arkuszy chcesz wstawić?", "Dodaj arkusze",,,,,, 1) Jeśli ShtCount = False Then Exit Sub Else For i = 1 To ShtCount Worksheets. Add Next i End If End Sub

Spowoduje to wprowadzenie liczby arkuszy roboczych, które chcesz wstawić. Po prostu podaj liczbę w polu wprowadzania i kliknij OK, natychmiast wstawi te wiele arkuszy.

# 7 - Usuń wszystkie puste arkusze ze skoroszytu

Kod:

 Sub Delete_Blank_Sheets () Dim ws As Worksheet Application.DisplayAlerts = False Application.ScreenUpdating = False For Each ws w ActiveWorkbook.Worksheets If WorksheetFunction.CountA (ws.UsedRange) = 0 Then ws.Delete End If Next ws Application.DisplayAlerts = True Application .ScreenUpdating = True End Sub

Spowoduje to usunięcie wszystkich pustych arkuszy ze skoroszytu, nad którym pracujemy.

# 8 - Wstaw pusty wiersz po każdym innym wierszu

Kod:

 Sub Insert_Row_After_Every_Other_Row () Dim rng As Range Dim CountRow As Integer Dim i As Integer Ustaw rng = Selection CountRow = rng.EntireRow.Count For i = 1 To CountRow ActiveCell.EntireRow.Insert ActiveCell.Offset (2, 0). Napis końcowy

Najpierw musisz wybrać zakres, w którym chcesz wstawić alternatywne puste wiersze.

# 9 - Podświetl błąd pisowni

Kod:

 Sub Chech_Spelling_Mistake () Dim MySelection As Range dla każdego MySelection w ActiveSheet.UsedRange If Not Application.CheckSpelling (Word: = MySelection.Text) Then MySelection.Interior.Color = vbRed End If Next MySelection End Sub

Najpierw wybierz dane i uruchom kod VBA. Podświetli komórki, które zawierają błędy ortograficzne.

# 10 - Zmień wszystko na wielkie litery

Kod:

 Sub Change_All_To_UPPER_Case () Dim Rng As Range dla każdego Rng w zaznaczeniu.Cells If Rng.HasFormula = False Then Rng.Value = UCase (Rng.Value) End If Next Rng End Sub

Najpierw wybierz dane i uruchom kod. Konwertuje wszystkie wartości tekstowe na wielkie litery.

# 11 - Zmień wszystko na małe litery

Kod:

 Sub Change_All_To_LOWER_Case () Dim Rng As Range dla każdego Rng w zaznaczeniu.Cells If Rng.HasFormula = False Then Rng.Value = LCase (Rng.Value) End If Next Rng End Sub

First, select the data and run the code. It will convert all the text values to lower case characters in excel.

#12 – Highlight All the Commented Cells

Code:

 Sub HighlightCellsWithCommentsInActiveWorksheet() ActiveSheet.UsedRange.SpecialCells(xlCellTypeComments).Interior.ColorIndex = 4 End Sub

Result: 

#13 – Highlight All the Blank Cells

Code:

 Sub Highlight_Blank_Cells() Dim DataSet As Range Set DataSet = Selection DataSet.Cells.SpecialCells(xlCellTypeBlanks).Interior.Color = vbGreen End Sub

First, select the data range and run the code. It will highlight all the blank cells with green color.

#14 – Hide All Sheets Except One Sheet

Code:

 Sub Hide_All_Except_One() Dim Ws As Worksheet For Each Ws In ActiveWorkbook.Worksheets If Ws.Name  "Main Sheet" Then Ws.Visible = xlSheetVeryHidden Next Ws End Sub

The above code hides all the sheets except the sheet named as “Main Sheet”. You can change the worksheet name as per your wish.

#15 – Unhide All Sheets

Code:

 Sub UnHide_All() Dim Ws As Worksheet For Each Ws In ActiveWorkbook.Worksheets Ws.Visible = xlSheetVisible Next Ws End Sub

This will unhide all the hidden sheets.

#16 – Delete All Files in the Folder

Code:

 Sub Delete_All_Files() 'You can use this to delete all the files in the folder Test '' On Error Resume Next Kill "C:\Users\Admin_2.Dell-Pc\Desktop\Delete Folder\*.*" On Error GoTo 0 End Sub

Change the folder path which is marked in red as per your folder deletion.

#17 – Delete Entire Folder

Code:

 Sub Delete_Whole_Folder() 'You can use this to delete entire folder On Error Resume Next Kill "C:\Users\Admin_2.Dell-Pc\Desktop\Delete Folder\*.*" 'Firstly it will delete all the files in the folder 'Then below code will delete the entire folder if it is empty RmDir "C:\Users\Admin_2.Dell-Pc\Desktop\Delete Folder\" 'Note: RmDir delete only a empty folder On Error GoTo 0 End Sub

Change the folder path which is marked in red as per your folder deletion.

#18 – Find the Last Used Row in the Sheet

Code:

 Sub Last_Row() Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp).Row MsgBox LR End Sub

Here we find the Last used Row in the Sheet

#19 – Find the Last Used Column in the Sheet

Code:

 Sub Last_Column() Dim LC As Long LC = Cells(1, Columns.Count).End(xlToLeft).Column MsgBox LC End Sub

Here we find the Last used Column in the Sheet