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ů
- Vytisknout všechny názvy listů
- Vložte do VBA index různých barev
- Vložte sériové číslo shora
- Vložte sériové číslo zdola
- Vložte sériové číslo od 10 do 1
- Vložte pracovní listy, kolik chcete
- Odstraňte všechny prázdné listy ze sešitu
- Za každý další řádek vložte prázdný řádek
- Zvýrazněte pravopisnou chybu
- Změnit vše na velká písmena
- Změnit vše na malá písmena
- Zvýrazněte všechny komentované buňky
- Zvýrazněte všechny prázdné buňky
- Skrýt všechny listy kromě jednoho listu
- Odkrýt všechny listy
- Odstraňte všechny soubory ve složce
- Odstranit celou složku
- Najděte poslední použitý řádek v listu
- 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