Příklady VBA - Seznam nejlepších 19 příkladů Excel VBA pro začátečníky

Příklady Excel VBA pro začátečníky

Makra jsou vaším nejlepším přítelem, pokud jde o zvýšení produktivity nebo úsporu času na pracovišti. Od malých úkolů po velké úkoly můžeme automatizovat pomocí kódovacího jazyka VBA. Vím často, že jste si možná mysleli na některá omezení, která má Excel, ale s kódováním VBA můžete všechna tato omezení eliminovat. Dobře, pokud jste v tomto článku bojovali s VBA a stále jste začátečník, uvedeme některé užitečné příklady kódu makra VBA v aplikaci Excel.

Seznam nejlepších 19 příkladů

  1. Vytisknout všechny názvy listů
  2. Vložte do VBA index různých barev
  3. Vložte sériové číslo shora
  4. Vložte sériové číslo zdola
  5. Vložte sériové číslo od 10 do 1
  6. Vložte pracovní listy, kolik chcete
  7. Odstraňte všechny prázdné listy ze sešitu
  8. Za každý další řádek vložte prázdný řádek
  9. Zvýrazněte pravopisnou chybu
  10. Změnit vše na velká písmena
  11. Změnit vše na malá písmena
  12. Zvýrazněte všechny komentované buňky
  13. Zvýrazněte všechny prázdné buňky
  14. Skrýt všechny listy kromě jednoho listu
  15. Odkrýt všechny listy
  16. Odstraňte všechny soubory ve složce
  17. Odstranit celou složku
  18. Najděte poslední použitý řádek v listu
  19. Najděte poslední použitý sloupec v listu

Podívejme se každý z těchto příkladů podrobně.

# 1 - Tisk všech jmen listů

Kód:

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

Tím se rozbalí všechny názvy listů na aktivní list.

# 2 - Vložte jiný barevný index do VBA

Kód:

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

Tím vložíte čísla od 1 do 56 a jejich barevný index do dalšího sloupce.

# 3 - Vložte sériové číslo shora

Kód:

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

Tím se vloží sériová čísla od 1 do 10 shora.

# 4 - Vložte sériové číslo zdola

Kód:

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

Tím se vloží sériová čísla od 1 do 20 od spodní části.

# 5 - Vložte sériové číslo od 10 do 1

Kód:

Sub Ten_To_One () Dim i As Integer Dim j As Integer j = 10 For i = 1 To 10 Range ("A" & i). Value = jj = j - 1 Next i End Sub

Tím se vloží sériová čísla od 10 do 1 shora.

# 6 - Vložte pracovní listy, kolik chcete

Kód:

Sub AddSheets () Dim ShtCount As Integer, i As Integer ShtCount = Application.InputBox ("How Sheets you would like to insert?", "Add Sheets",,,,,, 1) If ShtCount = False Then Exit Sub Else Pro i = 1 do pracovních listů ShtCount. Přidat další i Konec, pokud Konec Sub

Budete požádáni o zadání počtu listů, které chcete vložit. Stačí zadat číslo do vstupního pole a kliknout na Ok, vloží to mnoho listů okamžitě.

# 7 - Odstraňte všechny prázdné listy ze sešitu

Kód:

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

Tímto odstraníte všechny prázdné listy ze sešitu, na kterém pracujeme.

# 8 - Vložte prázdný řádek za každý další řádek

Kód:

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

Nejprve musíte vybrat rozsah, do kterého chcete vložit alternativní prázdné řádky.

# 9 - Zvýrazněte pravopisnou chybu

Kód:

Sub Chech_Spelling_Mistake () Dim MySelection jako rozsah pro každý MySelection v ActiveSheet.UsedRange, pokud není Application.CheckSpelling (Word: = MySelection.Text), pak MySelection.Interior.Color = vbRed End If Next MySelection End Sub

Nejprve vyberte data a spusťte kód VBA. Zvýrazní buňky, které mají pravopisné chyby.

#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

Zde najdeme poslední použitý řádek v listu

# 19 - Najděte poslední použitý sloupec v listu

Kód:

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

Zde najdeme poslední použitý sloupec v listu

Zajímavé články...