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ě.

Tuto šablonu aplikace Excel VBA Excel si můžete stáhnout zde - Šablona aplikace Excel VBA Excel

# 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ží se tolik 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ím se odstraní 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 - Změnit vše na velká písmena

Kód:

 Sub Change_All_To_UPPER_Case () Dim Rng jako rozsah pro každý Rng ve výběru. Buňky, pokud Rng.HasFormula = False Then Rng.Value = UCase (Rng.Value) Konec, pokud další Rng End Sub 

Nejprve vyberte data a spusťte kód. Převede všechny textové hodnoty na velká písmena.

# 11 - Změnit vše na malá písmena

Kód:

 Sub Change_All_To_LOWER_Case () Dim Rng jako rozsah pro každý Rng ve výběru. Buňky, pokud Rng.HasFormula = False, pak Rng.Value = LCase (Rng.Value) Konec, pokud další Rng End Sub 

Nejprve vyberte data a spusťte kód. Převede všechny textové hodnoty na malá písmena v aplikaci Excel.

# 12 - Zvýrazněte všechny komentované buňky

Kód:

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

Výsledek: 

# 13 - Zvýrazněte všechny prázdné buňky

Kód:

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

Nejprve vyberte rozsah dat a spusťte kód. Zvýrazní všechny prázdné buňky zelenou barvou.

# 14 - Skrýt všechny listy kromě jednoho listu

Kód:

 Sub Hide_All_Except_One () Dim Ws jako list pro každou Ws v ActiveWorkbook.Worksheets Pokud Ws.Name "Hlavní list", pak Ws.Visible = xlSheetVeryHidden Další Ws End Sub 

Výše uvedený kód skryje všechny listy kromě listu s názvem „Hlavní list“. Název listu můžete změnit podle svého přání.

# 15 - Odkrýt všechny listy

Kód:

 Sub UnHide_All () Dim Ws jako list pro každou Ws v ActiveWorkbook.Worksheets Ws.Visible = xlSheetVisible Další Ws End Sub 

Tím se skryjí všechny skryté listy.

# 16 - Odstranit všechny soubory ve složce

Kód:

 Sub Delete_All_Files () 'Můžete použít k odstranění všech souborů ve složce Test' Při chybě Pokračovat Další zabít "C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Odstranit složku \ *. *" Při chybě GoTo 0 End Sub 

Změňte cestu ke složce, která je označena červeně podle smazání složky.

# 17 - Odstranit celou složku

Kód:

 Sub Delete_Whole_Folder () 'Můžete to použít k odstranění celé složky Při chybě Pokračovat Další zabít "C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Delete Folder \ *. *"' Nejprve smaže všechny soubory ve složce „Pak níže uvedený kód smaže celou složku, pokud je prázdná RmDir" C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Delete Folder \ "'Poznámka: RmDir smaže pouze prázdnou složku Při chybě GoTo 0 End Sub 

Změňte cestu ke složce, která je označena červeně podle smazání složky.

# 18 - Najděte poslední použitý řádek v listu

Kód:

 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