Súčet súm z viacerých hárkov

Spočítávať sumy z mnohých listov (napr. z 50) pomocou tabuľkovej matematickej funkcie SUM alebo SUBTOTAL ručne je veľmi pracné. Riešme to teda pomocou programu Spol. Dajte si do lišty nástrojov nejakú ikonu, a priraďte k nej makro (Spol).

Prvý list
Listy

Na obrázku vidíme prvý list nazvaný tyd1, v ktorom zapisujeme tržby. Na liste môžeme mať toľko stĺpcov a riadkov, koľko je v Exceli možné. V prípade tohoto príkladu je treba začať v prvom stĺpci a prvom riadku, i keď obecne to nie je nutné, potom však treba zmeniť niektoré riadky programu. Listov v Exceli môžete mať toľko, koľko umožní výkon Vášho PC.

Ak kliknete na ikonu, na ktoré je prepojené makro, objavia sa súčty (na obr.r.8 Součty). V ďalších listoch aj prenos. Treba začať listom Tyd1 - aktivovať a kliknúť na ikonu s makrom, v tomto liste sa vytvoria súčty a v nasledujúcom tiež, aj prenos. Samozrejme v nasledujúcom liste už musía byť uvedené tržby. Teda kliknutím na ikonu prepojenú s makrom sa vždy vykoná súčet v aktívnom liste, prenos do nasledujúceho listu a súčet.


Public Sub Spol()
   ' Priradiť makro ikone
   Dim j As Integer, i As Integer, k As Integer, sss As Double, ssa As Double, ssr As Double
   Dim a As Double
   ssa = 0#
   sss = 0#
   ssr = 0#
   a = 0#
   ActiveSheet.Select
   j = ActiveSheet.Index
   'Zistíme index aktívneho listu, aby sme potom
   'mohli použiť WORKSHEETS(index).Takto môžeme
   'manipulovať s pojmami nasledujúci list, alebo
   'predchádzajúci list
   'j.. číslo (index) zvoleného listu, na ktorý máme kliknuté
    ActiveCell.CurrentRegion.Select
   'stĺpce v ktorých je zápis(alebo len sformátovaná bunka)
   'aspoň v jednej bunke a všetky riadky v ktorých je
   'zápis (alebo len sformátovaná bunka) aspoň v jednej bunke
   'doporučujem pečlivo naformátovať túto oblasť,
   'predpoklad - v liste máte len jednu oblasť
   'treba to vyskúšať tak, že dáme CTRL + END a musí sa aktivovať posledná bunka
   'ak to nie je tak, tak treba odstrániť riadky a stĺpce
   posr = ActiveSheet.UsedRange.Rows.Count ' počet riadkov použitej oblasti
   posl = ActiveSheet.UsedRange.Columns.Count  'počet stĺpcov
         For k = 2 To posl ' od stĺpca č. 2 po posledný
         ssr = 0#
            For i = 2 To posr - 1 ' od riadku 2 až po predposledný riadok
            ssa = Cells(i, k)
            ssr = ssa + ssr ' súčet riadkov
            sss = ssa + sss 'celkový súčet sčíta všetky
            'bunky vo všetkých stĺpcoch v poslednom riadku
            Next i
         Cells(posr, k).Value = ssr ' zápis súčtu riadkov v jednotlivých stĺpcoch od 2 po  posl
         Cells(posr, k).Select
         Selection.Font.ColorIndex = 5
         Selection.Font.Bold = True
         Selection.NumberFormat = "#,##0.00"
         Next k
   Cells(posr, posl).Value = sss
   Columns(posl).EntireColumn.AutoFit
   a = Cells(posr, posl).Value
   Do While j < Worksheets.Count
   j = j + 1
   Worksheets(j).Select ' nasledujúci list (hárok)
   Worksheets(j).Activate
   ActiveSheet.UsedRange.Select ' v nasledujúcom liste môžeme mať iný
   'počet riadkov aj stĺpcov
   Debug.Print "hárok"; j
   posr = ActiveSheet.UsedRange.Rows.Count
   posl = ActiveSheet.UsedRange.Columns.Count
   Cells(2, posl).Value = a 'prenos
   Cells(2, posl).Select
   Selection.NumberFormat = "#,##0.00"
   Selection.Font.Bold = True
   Selection.Font.ColorIndex = 9
   Columns(posl).EntireColumn.AutoFit
   ssa = 0#
   sss = 0#
   ssr = 0#
      For k = 2 To posl ' od stĺpca č. 2 po posledný
      ssr = 0#
         For i = 2 To posr - 1 ' od riadku 2 až po predposledný riadok
         ssa = Cells(i, k)
         ssr = ssr + ssa ' súčet riadkov v jednom stĺpci
         sss = ssa + sss
         Next i
      Cells(posr, k).Value = ssr
      Cells(posr, k).Select
      Selection.Font.ColorIndex = 5
      Selection.Font.Bold = True
      Selection.NumberFormat = "#,##0.00"
      Next k
   Cells(posr, posl).Value = sss
   a = Cells(posr, posl)
 Loop
End Sub    

Je veľmi dôležité si uvedomiť, že akonáhle urobíme čo i len v jedinom liste zmenu (opravu tržieb), celý proces spúšťania programu je treba vykonať znovu, kým pri vkladaní matematických tabuľkových funkcií ak použijeme prilepiť špeciálne a prilepiť prepojenie, každá zmena tržieb sa prejaví v súčtoch automaticky.

Stiahnite si súbor Spolut.zip   Veľkosť: 11 kB,   obsahuje program
Stiahnite si súbor SpoluPr.zip   Veľkosť: 10 kB,   obsahuje príklad
Valid HTML 4.01 Transitional
Stránka je v súlade s aktuálnymi normami.



© Klára Mrázová