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!
Makro pro zjištění počtu buněk dle barvy
-
- nováček
- Příspěvky: 12
- Registrován: březen 16
- Pohlaví:
- Stav:
Offline
Makro pro zjištění počtu buněk dle barvy
- Přílohy
-
- DH2017 2.0.xlsm
- (417.51 KiB) Staženo 31 x
Re: Makro pro zjištění počtu buněk dle barvy
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
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
-
- Pohlaví:
Re: Makro pro zjištění počtu buněk dle barvy
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.
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.
-
- nováček
- Příspěvky: 12
- Registrován: březen 16
- Pohlaví:
- Stav:
Offline
Re: Makro pro zjištění počtu buněk dle barvy
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 :)
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
-
- 1
- 608
-
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
- 1908
-
od doudinin
Zobrazit poslední příspěvek
28 srp 2023 20:37
-
-
- 4
- 1481
-
od Stenatko
Zobrazit poslední příspěvek
19 čer 2023 14:50
-
- 1
- 1782
-
od atari
Zobrazit poslední příspěvek
28 dub 2023 12:08
-
- 9
- 1125
-
od mmmartin
Zobrazit poslední příspěvek
29 srp 2023 16:47
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 11 hostů