Makro pro zjištění počtu buněk dle barvy

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Martin Švach
nováček
Příspěvky: 12
Registrován: březen 16
Pohlaví: Nespecifikováno
Stav:
Offline

Makro pro zjištění počtu buněk dle barvy

Příspěvekod Martin Švach » 21 pro 2016 14:53

Zdravím všechny,

potřeboval bych vymyslet makro, které by spočítalo počet buněk určité barvy (modrá, žlutá, červená).

V záložce "Linz" od sloupce AN začínám vkládat výkaz vagónů, které si pak barevně značím - viz legenda vedle.
Dole pod výkazem vagónů je malá tabulka - tam bych potřeboval, aby se doplňovaly počty buněk dle barvy.
Každý sloupec = 1 vlak.

Sloupec AN jsem připravil jako příklad, jak by to mělo vypadat. :)

Předem díky!
Přílohy
DH2017 2.0.xlsm
(417.51 KiB) Staženo 31 x

Reklama
MePExG
Level 2
Level 2
Příspěvky: 193
Registrován: srpen 16
Pohlaví: Muž
Stav:
Offline

Re: Makro pro zjištění počtu buněk dle barvy

Příspěvekod MePExG » 24 pro 2016 16:16

Súbor s makrami je v prílohe.

Makro na zisťovanie farieb a ich počet v oblasti.

Sub PocetF()
Set myRange = Application.InputBox(prompt:="Vyberte prosím, zdrojovú oblasť výpočtu", Type:=8)
Set Destination = Application.InputBox(prompt:="Vyberte prosím, kam ukladať výsledky počtov farieb", Type:=8)
posriadok = 0
For Each bunka In myRange
For i = 0 To posriadok + 1
If Destination.Offset(i, 0).DisplayFormat.Interior.Color = bunka.DisplayFormat.Interior.Color Then
Exit For
End If
Next i
If i = posriadok + 2 Then
'nenasiel
Destination.Offset(posriadok, 0).Interior.Color = bunka.DisplayFormat.Interior.Color
Destination.Offset(posriadok, 0) = 1
posriadok = posriadok + 1
Else
'nasiel na i
Destination.Offset(i, 0) = Destination.Offset(i, 0) + 1
End If
Next
End Sub

Makro na zisťovanie počtu farieb zo zadanej oblasti.

Sub PocetZadanaF()
Set myRange = Application.InputBox(prompt:="Vyberte prosím, zdrojovú oblasť výpočtu", Type:=8)
Set Destination = Application.InputBox(prompt:="Vyberte prosím, zadaných farieb", Type:=8)
Destination.Value = 0
For Each bunka In myRange
For Each vysledok In Destination
If vysledok.DisplayFormat.Interior.Color = bunka.DisplayFormat.Interior.Color Then
vysledok.Value = vysledok.Value + 1
End If
Next vysledok
Next bunka
End Sub
Přílohy
Farby.xlsm
(17.32 KiB) Staženo 64 x

guest
Pohlaví: Nespecifikováno

Re: Makro pro zjištění počtu buněk dle barvy

Příspěvekod guest » 04 led 2017 19:05

Nebudu vám mazat med, makra ani barvy okolo pusy, váš styl práce je na pytel. Připravujete se o řadu možností, od podmíněných funkcí COUNTIF, SUMIF, až po možnost práce s kontingenčními tabulkami. S barvou umí pracovat akorát filtr a tím to končí. Nemluvě o tom, že veškerá barevnost končí na první černobílé kopírce nebo tiskárně.

Potřebné vždy označujte nějakým textovým identifikátorem (prostě písmenky), a až poté třeba na nich postavte barevnost podmíněným formátem.

Martin Švach
nováček
Příspěvky: 12
Registrován: březen 16
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Makro pro zjištění počtu buněk dle barvy

Příspěvekod Martin Švach » 19 led 2017 10:29

to MePExG - díky za pomoc, dal jsem ještě hlavy dohromady s kamarádem a už to funguje jak má.
to xlnc - bylo to myšleno na mě nebo na MePExG? nějak jsem to nepochopil :)


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Monitor měnící barvy
    od BlackTroT » 01 úno 2024 08:12 » v Problémy s hardwarem
    1
    512
    od ITCrowd Zobrazit poslední příspěvek
    01 úno 2024 08:20
  • Problém s videem (rozsypané barvy) Příloha(y)
    od doudinin » 28 srp 2023 17:03 » v Multimédia (filmy, hudba, CDs/DVDs)
    6
    1809
    od doudinin Zobrazit poslední příspěvek
    28 srp 2023 20:37
  • Nějaký sw na zjištění stáří
    od Stenatko » 18 čer 2023 19:14 » v Vše ostatní (sw)
    4
    1444
    od Stenatko Zobrazit poslední příspěvek
    19 čer 2023 14:50
  • Tisk z excelu mění výšky buněk
    od Moonddur » 28 dub 2023 11:50 » v Kancelářské balíky
    1
    1655
    od atari Zobrazit poslední příspěvek
    28 dub 2023 12:08
  • Makro pro myš Rapture Python
    od mmmartin » 27 srp 2023 15:18 » v Problémy s hardwarem
    9
    1111
    od mmmartin Zobrazit poslední příspěvek
    29 srp 2023 16:47

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 8 hostů