Zápis vzorců do tabulky pomocí kódu VBA

Zápis složitějších vzorců do tabulky pomocí kódu VBA je pěkná dřina když neznáte fintu, kterou se v žádné učebnici ani od žádného lektora nedozvíte. To je know how z praxe. Marně se neříká: kdo to umí ten to dělá, kdo to neumí ten to učí.

Ukázku zápisu vzorců si ukážeme na primitivním příkladu. Máme jednoduchou tabulku do kteé postupně připisujeme název zboží, jednotkovou cenu a množství. Chceme ve sloupci cena mít vzorec, který jí spočítá. Nechť může mít tabulka už milion řádků.

• Běžný uživatel Excelu napíše do buňky D2 vzorec =B2*C2 jak je znázorněno na obrázku a vzorec nakopíruje za ouško milionkrát (jenže ve sloupci D bude milion nul a velikost sešitu se zvětší o pěkných pár bajtů)
• Pokročilejší uživatel nechce mít ve sloupci D samé 0 a tak vloží složitější vzorec s funkcí KDYŽ: =KDYŽ(A(B2<>"";C2<>"");B2*C2;"") a milionkrát ho nakopíruje. Ve sloupci D už nebude milion nul ,ale velikost sešitu se také nafoukne)
• Programátor VBA napíše vzorec do sloupce D jen když ve stejném řádku bude vyplněno množství. Využije událost WorkSheet_Change a vzorec do sloupce zapíše pomocí naší finty:
• Do buňky D2 zapíšeme libovolně složitý vzorec (v našem případě jednoduchý =B2*C2)
• Zapneme záznamník maker
• Dvojklikneme do buňky D2 nebo vybereme buˇku D2 a klikneme do řádku vzorců (tím se dostaneme do režimu editace). a klávesou ENTER zapíšeme vzorec do buňky D2 (i když už tam byl)
• Ukončíme záznam makra a tady je výsledek:

Sub Makro1()

'

' Makro1 Makro

' Makro zaznamenané 22.1.2014, Dell

'

'

Range("D2").Select

ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D3").Select

End Sub

• Vzorec z makra "=RC[-2]*RC[-1]" použijeme v události WorkSheet_Change, potom už zaznamenané makro můžeme jako nepotřebné odstranit.
• Kód události WorkSheet_Change. Komentáře vysvětlují její činnost. Zjednodušeně když změní obsah sloupce C, zapiše nebo odstraní se vzorec ze sloupce D. Všimněte si v události modrého vzorce, který jsme ukradli ze zaznamenaného makra. Vzorce "=B2*C2" a "=RC[-2]*RC[-1]" jsou stejné, první je v notaci A1 a druhý v notaci R1C1.

Private Sub Worksheet_Change(ByVal Target As Range)

'tato udalost nastane kdyz zapiseme do nejake bunky listu

'cislo radku a sloupce zmenene bunky do promennych

r = Target.Row

s = Target.Column

'testuji zda radek bunky do ktere pisu je vetsi nez 1 a sloupec je C

If r > 1 And s = 3 Then

'kdyz ve zmenene bunce neni cislo, ukonci udalost

If Not IsNumeric(Target) Then Exit Sub

'testuji zda bunka kterou menime neco obsahuje nebo je prazdna

If CStr(Target) <> "" Then

'bunka neni prazdna, do sloupce D zapis vzorec

Cells(r, 4) = "=RC[-2]*RC[-1]"

Else

'bunka je prazdna vymaz vzorec ve sloupci D

Cells(r, 4) = ""

End If

End If

End Sub

Stažení souboru

Zpět na hlavní stránku