Excelben azonos színű cellák értékének összeadása
2010-01-25T15:43:35+01:00
2010-01-27T17:03:04+01:00
2022-07-24T21:10:30+02:00
cinka.bela
Tisztelt Segítőkész Emberek!

Excelben szeretném elérni, hogy az azonos háttér színű cellák értékét összeadja.
Tehát adja meg pl. az összes sárga cella összegét.
Ha valamit később besárgítok vagy "nincs kitöltést" adok neki, akkor frissítse a végeredményt.

Mindez érvényes legyen az összes munkalapon színezett cellára. (de ha csak az adott munkalapon működik már az is nagy segítség)

Makrokban nem vagyok jártas egyáltalán. Vagy van erre standard függvény?

Előre is köszönettel.
Mutasd a teljes hozzászólást!
Nyomj egy Alt+F8-at, és a hozz létre egy makrót szines néven.

Aztán szerkeszd meg, hogy ez legyen a kódja:

Sub szines() For sorindex = 1 To 1000 For oszlopindex = 1 To 100 If Cells(sorindex, oszlopindex).Interior.ColorIndex = 6 Then eddigi_osszeg = eddigi_osszeg + Cells(sorindex, oszlopindex) End If Next Next MsgBox (Str(eddigi_osszeg)) Range("C1") = eddigi_osszeg End Sub

Ebben a kódban 4 változó van...
1,2: sorindex, és oszlopindex mögött álló szám. Ez azt mutatja, hogy mi legyen az utolsó sor illetve oszlop amit megvizsgál.

3: Hogy milyen színre reagáljon, ez a Interior.ColorIndex = 6
(Ez esetben sárga)

4(esetleg 5): Ez a két sor:
MsgBox (Str(eddigi_osszeg)) Range("C1") = eddigi_osszeg

Az msgbox-os rész kiírja neked egy szövegdobozba, a range("C1")-s pedig kiteszi a C1 cellába...

3 hibája van ennek az apró proginak:
Nem frissíti önmagát, nem veszi az összes munkalapot, elég lassú

De legalábbb megy

//Ha kell azt meg tudom adni, hogy hogyan veheti az összes munkalapot, vagy legalábbis valami olyasmit //

Remélem segítettem!

Üdv,
Stackman

szerk.
Ha esetleg nem sárgára, hanem teszem azt pirosra kell reagálni akkor a 6-st ki kell cserélni egy számra... No de melyikre?
Ezt így tudhatod meg:

Rámész egy üres cellára, majd:
Eszközök/Makró/Makró rögzítése

Ezután beszínezed a cellát olyan színűre, amilyent majd érzékelnie kell a programnak, ezután leállítod a makrót.

Bemész a most rögzített makróba és ott, ha minden igaz lesz egy ilyen sor:
Selection.Color.Index = egy szám
Na arra a számra kell kicserélni a 6-t!
Mutasd a teljes hozzászólást!

  • Kicsit gyorsabb for each ciklussal.

    Sub sárga() Dim ter As String Dim cell As Object Dim össz As Variant ter = "A1:F15" For Each cell In Range(ter) If cell.Interior.ColorIndex = 6 Then össz = össz + cell.Value Next Cells(20, 1) = össz End Sub Azzal, hogy a C1-be írattad az eddigi_összeget, meghamisíthatod az eredményt. Nyilván véletlenül írtad.
    Mutasd a teljes hozzászólást!
  • Köszönöm mindkettőtök válaszát!

    Most már legalább van sejtésem a makrókról. Ezt megértettem de másikat nem tudnék létre hozni.

    Meg tudnád akkor mondani azt is, hogy hogyan lehet a file-on belül lévő összes vagy bizonyos nevű munkalapokon futtatni?
    Ne kelljen minden munkalapon külön-külön futtatni és utána az összesítő nevű munkalapomon szummáznom.

    Ha szöveget is sárgítok akkor viszont hibát ír ki. Be lehet valahogy állítani, hogy csak számra reagáljon, szöveget figyelmen kívül hagyja?

    A másik megoldás viszont tényleg gyorsabban számol.

    Köszönöm!
    Mutasd a teljes hozzászólást!
  • Igen tényleg nyorsabb a másik ... Grat!
    (Nem feltétlen kell kiírni C1-be, az tényleg átír(hat) eredményeket, csak egy ötleg a kolegának, ha egy cellába ki akarja iratni...)

    Én csak auto didacta módon tolom...
    Na tehát leírom, hogy hogyan lehet megnézni minden munkalapon:
    (Átvéve Delila megoldását!)
    _____________________________________________________
    Sub szines() munkalap = Array("Munka1", "Munka2", "Munka3") For Each current_worksheet In munkalap Sheets(current_worksheet).Select Dim ter As String Dim cell As Object Dim össz As Variant ter = "A1:F15" For Each cell In Range(ter) If cell.Interior.ColorIndex = 6 Then össz = össz + cell.Value Next Next Range("Összesítés!A1") = össz End Sub
    _____________________________________________________

    Az utolsó sorban lévő:
    Range("Összesítés!A1") = össz

    azt adja meg, hogy az eredményt az Összesítéslap A1 cellájába írja ki

    Az elején lévő
    munkalap = Array("Munka1", "Munka2", "Munka3")
    sorban pedig az Array()-ben lévő lapokat nézi meg!
    //""-k között, vesszővl elválasztva kell beírni//

    Na szerintem ennyi, ha valamit nem értessz, írj!
    Mutasd a teljes hozzászólást!
  • Végül kimaradt a cella tartalmának vizsgálata. A szöveget tartalmazó színes cellánál kiakad, ha nem teszünk be egy erre vonatkozó feltételt.

    Sub szines_1() munkalap = Array("Munka1", "Munka2", "Munka3") For Each Current_Worksheet In munkalap Sheets(Current_Worksheet).Select ter = "A1:F15" For Each cell In Range(ter) If IsNumeric(cell) Then 'ha számot tartalmaz a cella If cell.Interior.ColorIndex = 6 Then össz = össz + cell.Value End If Next Next Range("Összesítés!A1") = össz End Sub


    Mutasd a teljes hozzászólást!
  • Köszönöm a szöveges cellákat kizáró megjegyzést.
    Bedolgoztam ezt is és működik.
    Így már gömbölyű!

    Bár amennyi idő alatt ennek utána jártam 10* összeadhattam volna manuálisan :)
    De ez után okosabb lettem és legközelebb gyorsabb lesz.


    VBA project alatt 2típusú mappa(csoport) jelenik meg. Mi a különbség a "Microsoft Excel Object" és a "Modules" között?

    Ezt a programozást tanultátok vagy valahol grafikus rámutatásos módszerrel el lehet készíteni és a kódot mellé automatikusan generálja a gép?
    Mutasd a teljes hozzászólást!
  • Na akkor erre is itt válasz, ha már eddig ilyen szépen összedolgoztunk Delilával:

    Ezt a kódot személy szerint én magam írtam, azonban ha rákattintasz arra, hogy új makró rögzítése (ahogy a piros szín színkódjának megállapításánál írtam), akkor felveszi amit csinálsz, amit később vissza tudsz játszani.

    Például, ha felveszed azt, hogy az A1-nek 4-et, a B1-nek "ab"-t adsz értékül, akkor ezt bármikor lefuttatod, utánnad csinálja...

    VBA project alatt 2típusú mappa(csoport) jelenik meg. Mi a különbség a "Microsoft Excel Object" és a "Modules" között?


    Ezek különböző típusok....
    (Nem tudom valaha használtál-e Acces-t akkor jobban érted)

    A Modules az általában egy subroutin ("lefutattható alapkód")
    A Microsoft Excel Object Excel objektum, pl. sheet (munkalap), vagy esetleg diagram stb.

    // Azaz a kettő között, nagyon pontatlanul fogalmazva az a különbség, hogy hogyan érzékeli a VBA... objektumként, vagy futtatható kódként //

    Később esetleg találhatsz Userform-okat is (én mondom az bonyolult), amiket meg "Űrlapként" fog fel a VBA...

    Ha valamit nem értesz, nyugodtan írj, válaszolunk
    Mutasd a teljes hozzászólást!
  • Tisztelt "Oktató Bizottság"!

    További kérdéseim merültek fel, kérem segítségüket!
    1. Eddig a makró működik, de mindig csak egy színnel. Szeretném, ha nem kellene külön makrót elindítani sárga, piros, zöld, stb. cellaháttér szín esetén hanem össze lehetne fűzni 1 makróba.

    2. Bár már kérdeztem ismét felmerült! Nem lehet automatikus frissítést kérni? Mint amikor a SZUM képlet is változik, ha egy cella tartalmát megváltoztatom. Ám valóban elég problémás lenne, ha minden egyes cella színezés után végig ugrálná a munkalapokat, nem beszélve arról, hogy több szín vizsgálata esetén a prog. futási idő is megnövekszik, amit minden színezés után kivárni nehézkes.
    Nem ismerem a lehetőségeket. Van áthidaló megoldás?

    Próbálkoztam saját kis agyammal de mindegyik ötletem megbukott.
    Mutasd a teljes hozzászólást!
  • A Select Case megoldja az összes háttérszínű cellád összegzését.
    Három színt írtam bele, de akárhánnyal kibővítheted. Ezzel a második kérdésed is megoldódik.

    Sub szines() ter = "A1:F15" For Each cell In Range(ter) If IsNumeric(cell) Then 'ha számot tartalmaz a cella Select Case cell.Interior.ColorIndex Case 6 'sárga össz_6 = össz_6 + cell.Value Case 3 'piros össz_3 = össz_3 + cell.Value Case 5 'kék össz_5 = össz_5 + cell.Value End Select End If Next Range("Összesítés!A1") = össz_3 Range("Összesítés!A2") = össz_5 Range("Összesítés!A3") = össz_6 End Sub
    Mutasd a teljes hozzászólást!
  • Még ennél is van egyszerűbb (remélem ez már teljes)

    Sub szines() munkalap = Array("Munka1", "Munka2", "Munka3") For Each current_worksheet In munkalap Sheets(current_worksheet).Select Dim ter As String Dim cell As Object Dim össz As Variant ter = "A1:F15" For Each cell In Range(ter) If IsNumeric(cell) Then If cell.Interior.ColorIndex <> xlNone Then össz = össz + cell.Value End If Next Next Range("Összesítés!A1") = össz End Sub

    cell.Interior.ColorIndex <> xlNone
    ---> Ha a cella nem egyenlő ezzel: "Szín nélküli cella", akkor...
    Mutasd a teljes hozzászólást!
  • A frissítést nagyon enhéz lenne megoldani... Esetleg egy ötlet:
    Menjél be a VBA projectbe, és menj rá a ThisWorkbookra.
    Ezután fölül a (General) hellyett válaszd ki a Workbook-t, és kattints rá az Open-re (a General mellett), hogyha most kiválasztassz egy esményt, és a programkódba beírod a most leírt makró nevét (ez esetben színes),
    Akkor az esemény létrejöttekor lefut a makró...
    Egy gyakorlati példa:

    Workbook\Open
    Private Sub Workbook_Open() szines End Sub

    Ez esetben a Munkafüzet megnyitásakor lefut a szines makró... Az az amit eddig tökéletesítgettünk

    Ha valamit nem értessz, írj nyugodtan
    Mutasd a teljes hozzászólást!
  • Lényeges különbség a makróink között, hogy Te 1 cellába íratod az összes színes hátterű cella értékének összegét, én meg külön-külön adatom és íratom ki az eltérő színűeket.
    A kérdésből nem derült ki, melyikre van szükség.
    Mutasd a teljes hozzászólást!
  • Igaz...
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
Címkék
abcd