V tomto článku, ukážu vám některé z nejvíce úžasné VBA Excel kódy, které můžete použít pro optimalizaci vaší práce. VBA je programovací jazyk, který lze použít k rozšíření možností MS Excel a dalších aplikací MS Office. Je to velmi užitečné pro uživatele MS Excel, protože může být použit k automatizaci vaší práce a výrazně zlepšit vaši efektivitu. Tento článek vás seznámí s VBA a ukáže vám některé z nejužitečnějších, připravené k použití kódů VBA. Tyto příklady Maker můžete použít k vytvoření vlastních skriptů, které vyhovují vašim vlastním potřebám.

není třeba pro programování zkušenosti využít informace v tomto článku, ale budete se očekává, že mají základní znalosti aplikace Excel. Pokud jste začátečník, doporučuji vám přečíst si článek 20 Excel vzorce, které byste měli začít používat, abyste se dozvěděli více o základních funkcích aplikace Excel.

připravil jsem pro Vás řadu připravených příkladů makra VBA Excel s velkou funkčností, kterou můžete použít k optimalizaci své práce. Abyste je mohli používat, musíte je „nainstalovat“ do souboru aplikace Excel. Následující odstavec se zabývá instalací makra aplikace Excel. Tuto část přeskočte, pokud jste s tím již obeznámeni.

jak nainstalovat makro

v aplikaci Excel stiskněte kombinaci kláves alt + F11. Tím se dostanete do editoru VBA v MS Excel. Poté klepněte pravým tlačítkem myši na složku Microsoft Excel Objects vlevo a vyberte Vložit => modul. Toto je místo, kde jsou makra uložena. Chcete-li makro použít, musíte dokument aplikace Excel uložit jako povoleno makro. Z karty file => uložit jako, zvolte Uložit jako sešit s podporou makra (the .XLSM extension) nyní je čas napsat své první makro!

1. Zkopírujte data z jednoho souboru do druhého.

Velmi užitečné makro, jak to ukazuje, jak zkopírovat rozsah dat zevnitř vba a jak vytvořit a pojmenovat nový sešit. Můžete jej snadno upgradovat tak, aby vyhovoval vašim vlastním požadavkům:

Sub CopyFiletoAnotherWorkbook () ' zkopírujte Datové listy ("Příklad 1").Rozsah ("B4: C15").Kopírovat ' vytvořit nový sešit sešity.Přidat ' vložit data ActiveSheet.Vložit ' vypnout aplikace upozornění aplikace.DisplayAlerts = False ' Uložte nově soubor. Změňte název adresáře. Aktivní pracovní kniha.Název Souboru SaveAs:="C:\Temp\MyNewBook.xlsx "' zapněte upozornění aplikace zpět na aplikaci.DisplayAlerts = TrueEnd Sub

2. Zobrazit skryté řádky

občas velké soubory aplikace Excel obsahují skryté řádky pro lepší přehlednost. Zde je makro, které odkryje všechny řádky z aktivního listu:

 sloupce Sub ShowHiddenRows ().Celý sloup.Skryté = Falešné Řádky.Celý.Hidden = FalseEnd Sub

3. Odstranění prázdných řádků a sloupců

prázdné řádky v aplikaci Excel jsou problémem se zpracováním dat. Zde je návod, jak se jich zbavit:

 Sub DeleteEmptyRowsAndColumns () 'deklarujte své proměnné. Dim MyRange jako rozsah Dim iCounter tak dlouho ' definovat cílový rozsah. Nastavit MyRange = Aktivní List.UsedRange ' Start reverzní opakování přes rozsah řádků. Pro iCounter = MyRange.Řádek.Počítat do 1 krok -1 ' pokud je celý řádek prázdný, odstraňte jej. Pokud Aplikace.CountA (řádky (iCounter).EntireRow) = 0 pak řádky (iCounter).Smazat 'Odstranit komentář, aby zjistit, které jsou prázdné řádky 'MsgBox "řádek" & iCounter & "je prázdný" End if 'zvětšení čítače dolů Vedle iCounter 'Krok 6: Start vzad opakování prostřednictvím řady Sloupů. Pro iCounter = MyRange.Sloupec.Počítat do 1 krok -1 ' Krok 7: pokud je celý sloupec prázdný, odstraňte jej. Pokud Aplikace.CountA(kolony (iCounter).EntireColumn) = 0 pak sloupce (iCounter).Smazat Konec, Pokud ' Krok 8: Zvyšte počítadlo dolů další Icounter End Sub

4. Najděte prázdnou buňku

 Sub FindEmptyCell() ActiveCell.Offset (1, 0).Vyberte Do While Not IsEmpty (ActiveCell) ActiveCell.Offset (1, 0).Vyberte LoopEnd Sub

5. Nahraďte prázdné buňky hodnotou.

jak již bylo zmíněno, prázdné buňky narušují zpracování dat a vytváření kontingenčních tabulek. Zde je kód, který nahrazuje všechny prázdné buňky 0. Toto makro má velmi velké aplikace, protože můžete použít k najít a nahradit N/A výsledky, jakož i ostatní znaky, jako jsou tečky, čárky nebo duplicitní hodnoty:

Sub FindAndReplace() 'Deklarovat proměnné Dim MyRange As Range Dim MyCell Jako Rozsah 'Uložit Sešit před změnou buňky? Vyberte případ MsgBox("tuto akci nelze vrátit zpět. "& _ " uložit sešit jako první?", Vbyesnocancel) případ je = Vbyes ThisWorkbook.Uložit případ je = Vbcancel Exit Sub End Select ' definovat cílový rozsah. Nastavte MyRange = Selection ' začněte procházet rozsahem. Pro každou Mycellu v MyRange 'zkontrolujte nulovou délku a přidejte 0. If Len (MyCell.Hodnota) = 0 pak MyCell = 0 konec, Pokud ' získat další buňky v rozsahu další MyCellEnd Sub

6. Seřadit čísla

následující makro seřadí ve vzestupném pořadí všechna čísla ze sloupce aktivní buňky. Stačí dvakrát kliknout na libovolnou buňku ze sloupce, který chcete třídit.Poznámka: kód musíte vložit do listu 1 a ne do modulu, aby fungoval:

Private Sub Worksheet_BeforeDoubleClick (ByVal Target as Range, Zrušit Jako Boolean) 'Deklarovat Proměnné Dim LastRow Tak Dlouho Najít poslední řádek LastRow = Buňky (Řádky.Hrabě, 1).Konec (xlUp).Řádek ' Seřadit vzestupně na dvojkliku řádků sloupců ("6:" & LastRow).Seřadit _ Key1: = Buňky (6, ActiveCell.Sloupec), _ Order1: = xlAscendingEnd Sub

7. Odstraňte prázdné mezery

data v sešitu občas obsahují další mezery (mezery), které mohou rušit analýzu dat a poškodit vzorce. Tady je makro, které odstraní všechny mezery z předem zvoleného rozsahu buněk:

Sub TrimTheSpaces() 'Deklarovat proměnné Dim MyRange As Range Dim MyCell Jako Rozsah 'Uložit Sešit před změnou buňky Zvolte Případě MsgBox("nelze Zrušit tuto akci. "& _ " uložit sešit jako první?", Vbyesnocancel) případ je = Vbyes ThisWorkbook.Uložit případ je = Vbcancel Exit Sub End Select ' definovat cílový rozsah. Nastavte MyRange = Selection ' začněte procházet rozsahem. Pro každou Mycelu v MyRange ' ořízněte mezery. Pokud tomu tak není IsEmpty (MyCell), pak MyCell = Trim(MyCell) končí, pokud ' získejte další buňku v rozsahu další Mycellend Sub

8. Zvýrazněte dublicated hodnoty

někdy existují duplicitní hodnoty v několika sloupcích, které bychom chtěli osvětlit. Tady je makro, které dělá jen to:

Sub HighlightDuplicates() 'Deklarovat proměnné Dim MyRange As Range Dim MyCell Jako Rozsah Definovat cílové Rozmezí. Nastavte MyRange = Selection ' začněte procházet rozsahem. Pro každou Mycellu v MyRange 'Zajistěte, aby buňka měla formátování textu. Pokud Pracovní Listfunkce.CountIf (MyRange, MyCell.Hodnota) > 1 pak MyCell.Interiér.ColorIndex = 36 konec, Pokud ' získat další buňky v rozsahu další MyCellEnd Sub

9. Vrcholem desítce hodnoty

Tento kód bude upozornit na horní deset hodnot z výběru buněk:

Sub TopTen() Výběr.Formatpodmínky.AddTop10 Výběr.FormatConditions (Výběr.Formatpodmínky.Počítat).SetFirstPriority S Výběrem.Formatpodmínky (1).TopBottom = xlTop10Top ' změňte zde hodnost a zvýrazněte jiný počet hodnot .Rank = 10 .Procento = Falešný Konec S Výběrem.Formatpodmínky (1).Písmo .Barva = -16752384 .TintAndShade = 0 Konec S Výběrem.Formatpodmínky (1).Interiér .PatternColorIndex = xlAutomatic .Barva = 13561798 .TintAndShade = 0 Konec S Výběrem.Formatpodmínky (1).StopIfTrue = FalseEnd Sub

můžete snadno vyladit kód pro zvýraznění různých hodnot.

10. Zvýrazněte větší než hodnoty

při spuštění tohoto kódu se zobrazí okno. Zeptá se vás na hodnotu, kterou chcete porovnat vybrané buňky.

Sub HighlightGreaterThanValues() Dim i As Integer i = InputBox("Zadejte Větší Než Hodnotu", "Vstup Hodnoty") Výběr.Formatpodmínky.Smazat ' změňte operátora na xlLower a zvýrazněte výběr nižší než hodnoty.Formatpodmínky.Přidat Typ:=xlCellValue, operátor:=xlGreater, Formula1: = i výběr.FormatConditions (Výběr.Formatpodmínky.Počítat).SetFirstPriority S Výběrem.Formatpodmínky (1).Písmo.Barva = RGB (0, 0, 0).Interiér.Color = RGB (31, 218, 154) End WithEnd Sub

tento kód můžete vyladit a zvýraznit také nižší hodnoty.

jednoduché makro, které zvýrazní všechny buňky, které obsahují komentáře:

Sub HighlightCommentCells() Výběr.SpecialCells (xlCellTypeComments).Vyberte Výběr.Style= "Poznámka" konec Sub

12. Zvýrazněte buňky chybně napsanými slovy

to je velmi užitečné, když pracujete s funkcemi, které berou řetězce, ale někdo zadal řetězec s chybou a vaše vzorce nefungují. Zde je návod, jak tento problém vyřešit:

 Sub ColorMispelledCells () pro každý cl v ActiveSheet.UsedRange, Ne-Li Aplikace.CheckSpelling (Slovo:=cl.Text) pak _ cl.Interiér.ColorIndex = 28 Next clEnd Sub

13. Vytvořte kontingenční tabulku

zde je návod, jak vytvořit kontingenční tabulku z MS Excel (verze 2007). Zvláště užitečné, když děláte vlastní zprávu každý den. Můžete optimalizovat kontingenční tabulky vytvoření následujícím způsobem:

Sub PivotTableForExcel2007() Dim SourceRange Jako Rozsah Nastavit SourceRange = Sheets("List1").Rozsah ("A3:N86") ActiveWorkbook.PivotCaches.Vytvořit (_ SourceType: = xlDatabase, _ SourceData: = SourceRange, _ Version: = xlPivotTableVersion12).CreatePivotTable _ TableDestination:="", _ TableName:="", _ DefaultVersion:=xlPivotTableVersion12End Sub

14. Připojte aktivní sešit do e-mailu

můj oblíbený kód VBA. Umožňuje připojit a odeslat soubor, na kterém pracujete, s předdefinovanou e-mailovou adresou, názvem zprávy a tělem zprávy! Nejprve musíte nastavit odkaz na Microsoft Outlook (ve vašem VBA editior, klikněte na nástroje => odkazy a vyberte Microsoft Outlook).

 Sub SendFIleAsAttachment() 'deklarovat proměnné 'Nastavit odkaz na Microsoft Outlook Object library Dim Olapp jako Outlook.Aplikace Dim OLMail jako objekt ' Open Outlook spusťte novou položku pošty Set Olapp = New Outlook.Sada Aplikací OLMail = OLApp.CreateItem (0) OLApp.Relace.Logon ' Sestavte si e-mailovou položku a odeslat s OLMail .to = "[email protected]; [email protected]". CC ="".BCC = "" .Předmět = "Toto je předmět".Body = "Ahoj" .Příslušenství.Přidat ActiveWorkbook.Celé jméno .Zobrazit ' změnit na .Odeslat Odeslat bez přezkoumání konec s ' memory cleanup Set OLMail = nic Set Olapp = NothingEnd Sub

15. Odeslat všechny grafy aplikace Excel do prezentace aplikace PowerPoint

velmi užitečná makra, která vám umožní přidat všechny vaše grafy aplikace Excel v prezentaci aplikace Powerpoint jen s jedním kliknutím:

Sub SendExcelFiguresToPowerPoint() 'Nastavit odkaz na Objektové Knihovny Microsoft Powerpoint 'Deklarovat proměnné Dim PP Jako PowerPoint.Aplikace Dim PPPres Jako PowerPoint.Prezentace Dim PPSlide Jako PowerPoint.Slide Dim i jako Integer ' kontrola grafů; ukončete, pokud neexistují žádné grafy("data snímků").Vyberte, Zda Je Aktivován List.ChartObjects.Count < 1 pak msgstr "žádné grafy existující aktivní list" ukončete dílčí konec ,pokud ' otevřete PowerPoint a vytvořte novou prezentační sadu PP = nový PowerPoint.Aplikační Sada PPPres = PP.Dar.Přidat PP.Visible = True ' spusťte smyčku na základě počtu grafů pro I = 1 na ActiveSheet.ChartObjects.Count ' zkopírujte graf jako obrázek ActiveSheet.Chartobjekty (i).Graf.CopyPicture _ Velikost: = xlScreen, Formát: = Xlpicture aplikace.Wait (Now + TimeValue ("0: 00:1")) 'počet snímků a přidat nový snímek jako další dostupné číslo snímku ppSlideCount = PPPres.Snímek.Počet Set PPSlide = PPPres.Snímek.Přidat (SlideCount + 1, ppLayoutBlank) PPSlide.Vyberte ' Vložit obrázek a upravit jeho polohu; Přejděte na další graf PPSlide.Obrazec.Vložit.Vyberte PP.Aktivníokno.Výběr.ShapeRange.Zarovnat msoAlignCenters, pravda PP.Aktivníokno.Výběr.ShapeRange.Zarovnat msoAlignMiddles, Pravda, pak jsem 'Vyčištění Paměti Nastavit PPSlide = Nic Nastavit PPPres = Nic Nastavit PP = NothingEnd Sub

16. Odeslat tabulku aplikace Excel v MS Word

tabulky aplikace Excel jsou obvykle umístěny uvnitř textových dokumentů. Tady je automatizovaný způsob, jak export tabulky aplikace Excel do MS Word:

 Sub ExcelTableInWord() 'Nastavit odkaz na Objektové knihovny Microsoft Word 'Deklarovat proměnné Dim MyRange Jako je Excel.Rozsah Dim wd jako slovo.Aplikace Dim wdDoc jako Word.Dokument Dim WdRange Jako Word.Rozsah ' zkopírujte definované listy rozsahu ("tabulka příjmů").Rozsah ("B4: F10").Cop ' otevřete cílovou sadu dokumentů Word WD = New Word.Sada aplikací wdDoc = wd.Dokument.Otevřít _ (ThisWorkbook.Cesta && " PasteTable.docx") wd.Visible = True ' nastavit zaměření na cílovou záložku nastavit WdRange = wdDoc.Záložky ("DataTableHere").Rozsah ' odstraňte starou tabulku a vložte novou při chybě pokračovat další WdRange.Tabulky (1).Smazat WdRange.Vložit 'vložit do tabulky' upravte šířky sloupců WdRange.Tabulky (1).Sloupec.SetWidth _ (MyRange.Šířka / MyRange.Sloupec.Počet), wdAdjustSameWidth ' znovu vložte záložku wdDoc.Záložek.Přidat "DataTableHere", wdrange 'memory cleanup Set WD = nothing Set wdDoc = Nothing Set WdRange = NothingEnd Sub

17. Extrahujte konkrétní slovo z buňky

můžeme použít vzorce, pokud chceme extrahovat určitý počet symbolů. Ale co když chceme extrahovat pouze druhé slovo z věty nebo řady slov v buňce? Za tímto účelem můžeme pomocí VBA vytvořit vlastní funkci Excel. Jedná se o jednu z nejdůležitějších funkcí VBA, protože vám umožňuje vytvářet vlastní funkce, které v MS Excel neexistují. Pojďme dál a vytvoříme dvě funkce: findword () a findwordrev (). Zde je kód vba:

Funkce FindWord(Zdroj Jako Řetězec, Pozice As Integer) As String On Error Resume Next FindWord = Split(WorksheetFunction.Trim(Zdroj), " ")(Pozice - 1) On Error GoTo 0End FunctionFunction FindWordRev(Zdroj Jako Řetězec, Pozice As Integer) As String Dim Arr() As String Arr = VBA.Rozdělit(Pracovní Listfunkce.Trim (Source), " ") na error Resume Next FindWordRev = Arr (UBound (Arr) - Position + 1) na Error GoTo 0end Function

velmi pěkné, vytvořili jsme dvě funkce Cstom Excel. Nyní je zkuste použít v aplikaci Excel. Funkce = FindWordRev (A1, 1) vezme poslední slovo z buňky A1. Funkce = FindWord (A1, 3) vezme třetí slovo z buňky A1 atd.

18. Chraňte svůj sešit

někdy chceme chránit data v našem souboru, abychom je mohli změnit pouze my. Zde je návod, jak to udělat s VBA:

Sub ProtectSheets() 'Deklarovat proměnné Dim ws As Worksheet Start smyčky přes všechny pracovní listy Pro Každého ws V ActiveWorkbook.Ochrana listů a smyčka na další list ws.Chránit heslo:= "1234" další Wsend Sub

Gratulujeme! Protože to stále čtete, máte opravdu zájem o učení VBA. Jak jste již sami viděli, programovací jazyk VBA je velmi užitečný a může nám ušetřit spoustu času. Doufám, že jste našli tyto informace užitečné a použít ji, aby se stal mistrem v MS Excel, VBA a počítačový software obecně.