Przykłady VBA - Lista 19 najlepszych przykładów Excel VBA dla początkujących

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ń do dużych zadań, 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

Przyjrzyjmy się szczegółowo każdemu z tych przykładów.

# 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 kolorów 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

This will delete all the blank worksheets from the workbook we are working on.

#8 - Insert Blank Row After Every Other Row

Code:

Sub Insert_Row_After_Every_Other_Row() Dim rng As Range Dim CountRow As Integer Dim i As Integer Set rng = Selection CountRow = rng.EntireRow.Count For i = 1 To CountRow ActiveCell.EntireRow.Insert ActiveCell.Offset(2, 0).Select Next i End Sub

For this first, you need to select the range where you would like to insert alternative blank rows.

#9 - Highlight Spelling Mistake

Code:

Sub Chech_Spelling_Mistake() Dim MySelection As Range For Each MySelection In ActiveSheet.UsedRange If Not Application.CheckSpelling(Word:=MySelection.Text) Then MySelection.Interior.Color = vbRed End If Next MySelection End Sub

First, select the data and run the VBA code. It will highlight the cells which have spelling mistakes.

#10 - Change All To Upper Case Characters

Code:

Sub Change_All_To_UPPER_Case() Dim Rng As Range For Each Rng In Selection.Cells If Rng.HasFormula = False Then Rng.Value = UCase(Rng.Value) End If Next Rng End Sub

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

#11 - Change All To Lower Case Characters

Code:

Sub Change_All_To_LOWER_Case() Dim Rng As Range For Each Rng In Selection.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 “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:UsersAdmin_2.Dell-PcDesktopDelete 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:UsersAdmin_2.Dell-PcDesktopDelete 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:UsersAdmin_2.Dell-PcDesktopDelete 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

Tutaj znajduje się ostatnio używany wiersz w arkuszu

# 19 - Znajdź ostatnio używaną kolumnę w arkuszu

Kod:

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

Tutaj znajduje się ostatnio używana kolumna w arkuszu

Interesujące artykuły...