súčet v excel-i

excel není omalovánka, přece jen slouží k něčemu jinému. já bych chápal, že ta barva písma v buňce proto není náhodou co se komu chtělo obarvovat, ale výsledek nějaké podmínky - viz v menu "podmínečné formátování", sám to občas používám.
a stejnou podmínku, která způsobí omalování některých buněk, bych taky testoval pro ty součty. něco jako že sčítám sloupec hodnot, ve kterém je: (buňka1*platnost(podmínka1)) + (buňka2 * platnost(podmínka2)) + ...

na syntaxi se mrkni do helpu, já to potřebuju jednou za půl roku tak to tam vždycky znovu objevuju.

ale jestli fak testuješ jen barvy, to je jiná. sice to nemá smysl, ale jde to zadávat za domácí úkol.

Len doplnim, ze ak to bude scitanie na zaklade podmienky, mozete pouzit funkciu SUMIF.

Ahoj,
otázku som veľmi zjednodušil, excel rozhodne nepoužívam ako omaľovánku a priznám sa, že som očakával skôr odbornejšiu odpoveď, kecať o farebných obrázkoch sa dá určite inde. Nižšie popísané som už skúšal, aj som predpokladal, že sa to bude dať riešiť len makrom, ale vyhýbal som sa tomu, pretože makro je pre mňa španielska dedina. Štandardné funkcie to ale asi nezvládnu.
Vďaka

Ak Excel nepoužívaš ako omaľovánku, tak sa to dá riešiť aj bez makra.

Počítať v Exceli čokoľvek na základe farby buniek ide len pomocou makra - s jednoduchým vzorcom si nevystačíš.

Používať farebné odlíšenie buniek ako nosič novej informácie je vo všeobecnosti z praktických dôvodov vysoko neodporúčané.

Navic je nutno vzit do uvahy, ze zmena barvy podminenym formatovanim neni zjistitelna, vlastnost Interior.ColorIndex vraci puvodni hodnotu!

je to jednoduchý, makrem bez problémů:

Sub SumColors()
    b1 = 0                                          'definujeme počáteční hodnoty
    c1 = 0
    cerna = 0
    cervena = 255
    For n = 1 To 10                                 'rozsah buněk bude od 1 do 10
        barva = Range("a" & n).Font.Color           'vytáhneme barvu písma
        hodnota = Range("a" & n)                    'zjistíme hodnotu buňky
        If Not IsNumeric(hodnota) Then hodnota = 0  'pokud v buňce není číslo, bere se jako nula
        If barva = cerna Then c1 = c1 + hodnota     'sčítáme černé hodnoty
        If barva = cervena Then b1 = b1 + hodnota   'sčítáme červené hodnoty
    Next
    Range("b1") = b1                                'nakonec dosadíme do buněk
    Range("c1") = c1
End Sub

(15 minut - píšu pomalu)

EDIT:// hodnoty proměnných "cervena" a "cerna" musíš definovat podle použitých barev.

ahoj Mia,
ďakujem, je to super, ale ja mám takých stĺpcov v hárku 52 po 1000 riadkov. Ako do makra zapíšem začiatok a koniec, keď sú to bunky T10 až T1010.
vďaka, ahoj
PS. Zatiaľ to pokazené nie je - ale keď musíš, tak musíš a na niečo zomrieť musíme

Sub SumColors()
......
    For n = 10 To 1010                              'rozsah buněk bude od 10 do 1010
        barva = Range("T" & n).Font.Color           'vytáhneme barvu písma
        hodnota = Range("T" & n)                    'zjistíme hodnotu buňky
......
End Sub

Jednoduše, v cyklu For n=xx to yy se dosadí počáteční a koncová buňka a v parametru Range("ZZ" & n) znamená písmeno v uvozovkách sloupec. Ten znak "&" znamená zkombinovat do jednoho řetězce, tzn když písmeno je "AB" a n=20, vznikne z toho "AB20". V posledních dvou řádcích makra definuješ, do které buňky se součty zapisují.

Ďalšou možnosťou je prejsť bunky pomocou cyklu For Each, napr:

For Each aCell in Range("T10:T1010")
    barva = aCell.Font.Color
    hodnota = aCell.Value
    ...
Next aCell

Ahoj, ako toto zopakujem 52 krát, s tým, že výsledky budú v "F3" a F4", "I3" a "I4"...:

Sub SumBlack()
    c3 = 0
    cerna = 0
    For n = 7 To 1000
        barva = Range("b" & n).Font.Color
        hodnota = Range("b" & n)
        If Not IsNumeric(hodnota) Then hodnota = 0
        If barva = cerna Then c3 = c3 + hodnota
    Next
    Range("c4") = c4
     c4 = 0
    cerna = 0
    For n = 7 To 1000
        barva = Range("c" & n).Font.Color
        hodnota = Range("c" & n)
        If Not IsNumeric(hodnota) Then hodnota = 0
        If barva = cerna Then c4 = c4 + hodnota
    Next
    Range("c4") = c4
End Sub

V Exceli si môžeš definovať vo VBA vlastnú funkciu, ktorá sa dá potom používať priamo vo vzorci rovnako ako štandardné funkcie: Create your own worksheet functions

Stále si nenapísal, na základe čoho sa farbia jednotlivé bunky. Je to na základe podmieneného formátovania, alebo to niekto musí ručne nastavovať? Ak je to ten druhý prípad, tak si rozmysli, či to nechceš zmeniť - hlavne v prípade, že ten súbor nepoužívaš len ty sám.

Rozumim-li dobre pozadavku, tak zde je trochu ucesana procedura scitajici hodnoty ze sloupcu B7:B1000 (E7:E1000, H7:H1000,...) az 52 krat a ukladajici soucty do bunek dle barvy fontu - cerna do C3 a cervena do C4 (F3:F4, I3:I4,...).

Option Explicit

Sub Scitat()
  Dim Blok As Range, c As Range, Soucet As Range, i As Integer, ofs As Integer
  Set Soucet = Worksheets("list1").Range("c3")
  Set Blok = Worksheets("list1").Range("b7:b1000")
  ofs = 3  ' ofset pro dalsi sloupce
  For i = 0 To 51  ' pocet sloupcu
    Soucet.Offset(0, ofs * i).Value = 0
    Soucet.Offset(1, ofs * i).Value = 0
    For Each c In Blok.Offset(0, ofs * i).Cells
      If IsNumeric(c.Value) Then
        If c.Font.Color = 0 Then Soucet.Offset(0, ofs * i).Value = Soucet.Offset(0, ofs * i).Value + c.Value  ' cerna
        If c.Font.Color = 255 Then Soucet.Offset(1, ofs * i).Value = Soucet.Offset(1, ofs * i).Value + c.Value  ' cervena
      End If
    Next c
  Next i
End Sub

Doplnuji:
Barva je brana pro zakladni barvu fontu, pokud by bylo potreba rozlisovat podle barvy nastavene podminenym formatem, pak je nutno pouzit tytez podminky do procedury a misto c.Font.Color pouzit c.Value=podminka!

asi som to zle vysvetlil,
v "B3" potrebujem sčítať hodnotu "čiernych (automatická farba)" čísel zo stĺpca "B7-B1000" a v "B4" zas hodnotu "čiernych" čísel zo stĺpca "C7-C1000" - toto všetko opakovať 52 krát. (Cash-flow, čierne písmo - už uskutočnené, červené písmo - plánované, stĺpec B - príjmy za 1 týždeň, stĺpec C - výdavky za 1 týždeň...)
A poprosím Ťa aj krátke vysvetlenie k riadkom, nech to aj pochopím, nie odpíšem.
Vďaka

Tady je upravena procedura:

Option Explicit

Sub Scitat()
' deklarace promennych
  Dim Blok As Range, Soucet As Range, SumPrijmy As Single, SumVydani As Single
  Dim c As Range, i As Integer, ofs As Integer
  ' definice prohledavaneho bloku
  Set Blok = Worksheets("list1").Range("b7:b1000")
  ' definice bunky pro ulozeni vysledku souctu za sloupec b7:b1000
  Set Soucet = Blok.Offset(-4, 0).Resize(1, 1)
  ' ofset pro dalsi sloupce (E7:E1000, H7:H1000,...)
  ofs = 3
  ' vykonna smycka projde vsechny sloupce
  For i = 0 To 51  ' pocet sloupcu
    ' vynulovani promennych pro ulozeni mezisouctu
    SumPrijmy = 0
    SumVydani = 0
    For Each c In Blok.Offset(0, ofs * i).Cells
      ' testovani bunky ve sloupci prijmu b7:b1000 (e7:e1000, h7:h1000,...)
      If IsNumeric(c.Value) And _
      c.Font.Color = 0 Then SumPrijmy = SumPrijmy + c.Value  ' je cislo a cerna, pricist
      ' testovani bunky ve sloupci vydani c7:c1000 (f7:f1000, i7:i1000,...), ma offset(0,1) oproti sloupci b(..)
          If IsNumeric(c.Offset(0, 1).Value) And _
      c.Offset(0, 1).Font.Color = 0 Then SumVydani = SumVydani + c.Offset(0, 1).Value  ' je cislo a cerna, pricist
        Next c
        ' vlozeni hlavicky do a2 (d2,g2,...)
        Soucet.Offset(-1, (ofs * i) - 1).Value = "Týždeò: " & i + 1
        ' vlozeni hlavicky do a3 (d3,g3,...) pro prijmy
        Soucet.Offset(0, (ofs * i) - 1).Value = "Príjmy:"
        ' vlozeni souctu do bunky b3 (e3, h3,...) pro prijmy
        Soucet.Offset(0, ofs * i).Value = SumPrijmy
        ' vlozeni hlavicky do a4 (d4,g4,...) pro vydani
        Soucet.Offset(1, (ofs * i) - 1).Value = "Vydavky:"
        ' vlozeni souctu do bunky b4 (e4, h4,...) pro vydani
        Soucet.Offset(1, ofs * i).Value = SumVydani
      Next i
    End Sub

Pokud splnuje pozadovane, tak upravim pro zrychleni behu.

funguje to perfektne, niečo som odtiaľ vyhodil - aby to zbytočne nevytváralo hlavičky (som myslel kôli zrýchleniu prepočtu), takže, ak sa to dá ešte nejako upraviť, tak Ťa poprosím. Ale už aj tak je to OK.

Option Explicit

Sub Scitat()
' deklarace promennych
  Dim Blok As Range, Soucet As Range, SumPrijmy As Single, SumVydani As Single
  Dim c As Range, i As Integer, ofs As Integer
  ' definice prohledavaneho bloku
  Set Blok = Worksheets("Makro").Range("b7:b1000")
  ' definice bunky pro ulozeni vysledku souctu za sloupec b7:b1000
  Set Soucet = Blok.Offset(-4, 0).Resize(1, 1)
  ' ofset pro dalsi sloupce (E7:E1000, H7:H1000,...)
  ofs = 3
  ' vykonna smycka projde vsechny sloupce
  For i = 0 To 51  ' pocet sloupcu
    ' vynulovani promennych pro ulozeni mezisouctu
    SumPrijmy = 0
    SumVydani = 0
    For Each c In Blok.Offset(0, ofs * i).Cells
      ' testovani bunky ve sloupci prijmu b7:b1000 (e7:e1000, h7:h1000,...)
      If IsNumeric(c.Value) And _
      c.Font.Color = 0 Then SumPrijmy = SumPrijmy + c.Value  ' je cislo a cerna, pricist
      ' testovani bunky ve sloupci vydani c7:c1000 (f7:f1000, i7:i1000,...), ma offset(0,1) oproti sloupci b(..)
          If IsNumeric(c.Offset(0, 1).Value) And _
      c.Offset(0, 1).Font.Color = 0 Then SumVydani = SumVydani + c.Offset(0, 1).Value  ' je cislo a cerna, pricist
        Next c
        ' vlozeni souctu do bunky b3 (e3, h3,...) pro prijmy
        Soucet.Offset(0, ofs * i).Value = SumPrijmy
        ' vlozeni souctu do bunky b4 (e4, h4,...) pro vydani
        Soucet.Offset(1, ofs * i).Value = SumVydani
      Next i
    End Sub

Zrychleni spociva v tom. ze budou scitany pouze hodnoty z neprazdnych bunek ve sloupcich (t.j. nebude se prochazet radek 7 - 1000) , vlozeni hlavicek je to nejmensi. Pokud je v nasledujici procedure nepotrebujes, vloz znak "'" (apostrof) na zacatky radku s vkladanim hlavicek (v procedure oznaceno).

Option Explicit

Sub Scitat()
' deklarace promennych
  Dim ZacBloku As Range, Blok As Range, Soucet As Range, Sum As Single
  Dim c As Range, i As Integer, ofs As Integer, PoslRadek As Long
  ' definice prohledavaneho bloku
  Set ZacBloku = Worksheets("list1").Range("b7")
  ' definice bunky pro ulozeni vysledku souctu za sloupec b7:b1000
  Set Soucet = ZacBloku.Offset(-4, 0)
  ' ofset pro dalsi sloupce (E7:E1000, H7:H1000,...)
  ofs = 3
  ' vykonna smycka projde vsechny sloupce pocinaje bunkou b7,c7 (e7,f7; h7,i7;...) az
  ' po posledni neprazdnou bunku ve sloupci
  For i = 0 To 51  ' pocet sloupcu
    '************ radky mezi "***" lze vypustit, dle potreby vloz "'" (apostrof) na zacatky radku *****
    ' vlozeni hlavicky do a2 (d2,g2,...)
    Soucet.Offset(-1, (ofs * i) - 1).Value = "Týždeò: " & i + 1
    ' vlozeni hlavicky do a3 (d3,g3,...) pro prijmy
    Soucet.Offset(0, (ofs * i) - 1).Value = "Príjmy:"
    ' vlozeni hlavicky do a4 (d4,g4,...) pro vydani
    Soucet.Offset(1, (ofs * i) - 1).Value = "Vydavky:"
    '********************************************************************************************
    ' hledani ve sloupci prijmu b7:bxx (e7:exx, h7:hxx,...)
    ' vynulovani promenne pro ulozeni mezisouctu prijmy
    Sum = 0
    ' nalezeni posledni neprazdne bunky ve sloupci b7:bxx (e7:exx, h7:hxx,...)
    PoslRadek = LastRow("list1", ofs * i)
    If PoslRadek > 6 Then
    Set Blok = ZacBloku.Resize(PoslRadek - 6, 1).Offset(0, ofs * i)
      For Each c In Blok.Cells
        ' testovani bunky ve sloupci prijmu b7:bxx (e7:exx, h7:hxx,...)
        If IsNumeric(c.Value) And _
          c.Font.Color = 0 Then Sum = Sum + c.Value  ' je cislo a cerna, pricist
      Next c
    End If
    ' vlozeni souctu do bunky b3 (e3, h3,...) pro prijmy
    Soucet.Offset(0, ofs * i).Value = Sum
    '***
    ' hledani ve sloupci vydani c7:cxx (f7:fxx, i7:ixx,...)
    ' vynulovani promenne pro ulozeni mezisouctu vydani
    Sum = 0
    ' nalezeni posledni neprazdne bunky ve sloupci c7:cxx (f7:fxx, i7:ixx,...)
    PoslRadek = LastRow("list1", (ofs * i) + 1)
    If PoslRadek > 6 Then
      Set Blok = ZacBloku.Resize(PoslRadek - 6, 1).Offset(0, (ofs * i) + 1)
      For Each c In Blok.Cells
        ' testovani bunky ve sloupci vydani c7:cxx (f7:fxx, i7:ixx,...)
        If IsNumeric(c.Value) And _
          c.Font.Color = 0 Then Sum = Sum + c.Value  ' je cislo a cerna, pricist
      Next c
    End If
    ' vlozeni souctu do bunky b4 (e4, h4,...) pro vydani
    Soucet.Offset(1, ofs * i).Value = Sum
  Next i
End Sub

potrebna funkce LastRow je v dalsim prispevku, nebot je omezena delka prispevku

Pokracovani k predchozimu prispevku, pripoj za proceduru Scitat:

Function LastRow(L As String, ofs As Integer)
  Dim PosBunka As Range
  ' nastaveni na posledni radek listu ve sloupci
  Set PosBunka = Worksheets(L).Range("B:B").Offset(0, ofs).Cells(Range("B:B").Offset(0, ofs).Cells.Count)
  If IsEmpty(PosBunka) Then Set PosBunka = PosBunka.End(xlUp)
  If IsEmpty(PosBunka) Then  ' bunka na 1. radku  je take prazdna
    LastRow = 0
  Else
    LastRow = PosBunka.Row
  End If
End Function

S odstupem casu lze pozadovane resit bez makra a to vyuzitim maleho triku.
V bloku bunek B1:B1000 (C1:C1000) nastavit barvu fontu na automaticku a nastavit format bunek na cislo, pro zaporna cisla vybrat barvu cervena bez znamenka. Planovane prijmy (vydani) vkladat jako zaporne cislo, ktere bude zobrazeno jako cervene pismo bez znamenka.
Pro soucet v B3 pouzit vzorec: =SUMIF(B7:B1000;">0") a obdobne pro B4:=SUMIF(C7:C1000;">0")

Toto zopakovat pro dalsich 51 tydnu.

Pozn: poradna vlozila nekam jinam, nez jsem zamyslel

vyhadzuje mi to chybu v riadku:

PoslRadek = LastRow("Makro", ofs * i)

a je zvýraznené "LastRow"

Pro zjisteni duvodu chyby uved i chybove hlaseni, takhle byt na dalku, tezko zjistim pricinu.
Jen pro overeni, mas doinstalovanu funkci LastRow?
Predavas spravny nazev listu?
Zkusils krokovat proceduru (Editor VBA: Nastroje>View>LocalsWindow, kurzor mysi na proceduru a krokovat tlacitkem F8)?
Pouzivas jakou verzi Excelu?

Ďakujem Ti, teraz to už funguje super

psal jsem uz vcera, ale nejak se odpoved zasmodrchala mezi starsi, takze ji opakuji:

Pozadovane lze resit i bez makra a to vyuzitim maleho triku.
V bloku bunek B1:B1000 (C1:C1000) nastavit barvu fontu na automaticku a nastavit format bunek na cislo, pro zaporna cisla vybrat barvu cervena bez znamenka. Planovane prijmy (vydani) vkladat jako zaporne cislo, ktere bude zobrazeno jako cervene pismo bez znamenka.
Pro soucet v B3 pouzit vzorec: =SUMIF(B7:B1000;">0") a obdobne pro B4:=SUMIF(C7:C1000;">0")

Toto zopakovat pro dalsich 51 tydnu.

upravena verze bez funkce LastRow, nazev listu je na zacatku subrutiny v promenne List

Option Explicit
Sub Scitat()
' deklarace promennych
  Dim ZacBloku As Range, Blok As Range, Soucet As Range, Sum As Single
  Dim c As Range, i As Integer, ofs As Integer, PoslRadek As Long, List As String
  ' zadat nazev listu!
  List = "list1"
  ' definice prohledavaneho bloku
  Set ZacBloku = Worksheets(List).Range("b7")
  ' definice bunky pro ulozeni vysledku souctu za sloupec b7:bxx
  Set Soucet = ZacBloku.Offset(-4, 0)
  ' ofset pro dalsi sloupce (E7:Exx, H7:Hxx,...)
  ofs = 3
  ' vykonna smycka projde vsechny sloupce pocinaje bunkou b7,c7 (e7,f7; h7,i7;...) az
  ' po posledni neprazdnou bunku ve sloupci
  For i = 0 To 51  ' pocet sloupcu
    '************ radky mezi "***" lze vypustit, dle potreby vloz "'" (apostrof) na zacatky radku *****
    ' vlozeni hlavicky do a2 (d2,g2,...)
    Soucet.Offset(-1, (ofs * i) - 1).Value = "Týždeò: " & i + 1
    ' vlozeni hlavicky do a3 (d3,g3,...) pro prijmy
    Soucet.Offset(0, (ofs * i) - 1).Value = "Príjmy:"
    ' vlozeni hlavicky do a4 (d4,g4,...) pro vydani
    Soucet.Offset(1, (ofs * i) - 1).Value = "Vydavky:"
    '********************************************************************************************
    ' hledani ve sloupci prijmu b7:bxx (e7:exx, h7:hxx,...)
    ' vynulovani promenne pro ulozeni mezisouctu prijmy
    Sum = 0
    ' nalezeni posledni neprazdne bunky ve sloupci b7:bxx (e7:exx, h7:hxx,...)
    PoslRadek = Worksheets(List).Cells(Rows.Count, 2 + (ofs * i)).End(xlUp).Row
    If PoslRadek > 6 Then
      Set Blok = ZacBloku.Resize(PoslRadek - 6, 1).Offset(0, ofs * i)
      For Each c In Blok.Cells
        ' testovani bunky ve sloupci prijmu b7:bxx (e7:exx, h7:hxx,...)
        If IsNumeric(c.Value) And _
          c.Font.Color = 0 Then Sum = Sum + c.Value  ' je cislo a cerna, pricist
      Next c
    End If
    ' vlozeni souctu do bunky b3 (e3, h3,...) pro prijmy
    Soucet.Offset(0, ofs * i).Value = Sum
    ' hledani ve sloupci vydani c7:cxx (f7:fxx, i7:ixx,...)
    ' vynulovani promenne pro ulozeni mezisouctu vydani
    Sum = 0
    ' nalezeni posledni neprazdne bunky ve sloupci c7:cxx (f7:fxx, i7:ixx,...)
    PoslRadek = Worksheets(List).Cells(Rows.Count, 3 + (ofs * i)).End(xlUp).Row
    If PoslRadek > 6 Then
      Set Blok = ZacBloku.Resize(PoslRadek - 6, 1).Offset(0, (ofs * i) + 1)
      For Each c In Blok.Cells
        ' testovani bunky ve sloupci vydani c7:cxx (f7:fxx, i7:ixx,...)
        If IsNumeric(c.Value) And _
          c.Font.Color = 0 Then Sum = Sum + c.Value  ' je cislo a cerna, pricist
      Next c
    End If
    ' vlozeni souctu do bunky b4 (e4, h4,...) pro vydani
    Soucet.Offset(1, ofs * i).Value = Sum
  Next i
End Sub

som tu chvilu nebol, ale vdaka, je to ok a prijemne sviatky