Stránka 1 z 1
Jak vytáhnout data podle zabarvení buněk
Napsal: 15 bře 2016 11:13
od Martin Švach
Dobrý den,
Prosím o radu. Potřeboval bych co nejjednodušeji vytáhnout ze seznamu vozů pouze vozy, které nejsou zabarvené.
Příklad seznamu posílám v příloze.
Cíl je, abych měl okamžitě přehled o tom, které vozy nejsou zabarvené a nemusel spoléhat na lidský faktor (mě).
Z příkladu by tyto vozy měly být vypsány:
33 80 534 2 586-8
37 80 533 6 090-5
37 80 533 6 093-9
37 80 533 6 106-9
Děkuji za pomoc :)
Re: Jak vytáhnout data podle zabarvení buněk
Napsal: 15 bře 2016 19:40
od cmuch
Dobrý den,
to barevné značení děláte vy?
Kam by se měly ty vozy vypisovat?
Řádky budou proměnné?
Možná by stačil třeba pomocný sloupec vedle každého sloupce
a tam zapisovat nějaký příznak podle kterého pak třeba podmíněným formátováním
změnit barvu podbarvení daného auta na nějakou výraznou barvu.
Re: Jak vytáhnout data podle zabarvení buněk
Napsal: 16 bře 2016 13:19
od Martin Švach
Dobrý den,
barevné značení dělám já. Ten seznam vozů vytahuju z jiné databáze a následně páruju stejné vozy k sobě (barevné). Tzn. že se vrátily zpět. Ty neoznačené (bílé) se ještě nevrátily.
Vozy by se mohly vypisovat do nového listu, kde bych měl přehled, které se nevrátily zpět a nemusel je vyhledávat manuálně.
Tou otázkou ohledně řádků si nejsem jistý jak to myslíte. Hodnoty (čísla vozů) se budou měnit. Maximální počet řádků ve kterých jsou obsažené čísla vozů je 50. Více vozů nelze dát do jednoho vlaku.
Re: Jak vytáhnout data podle zabarvení buněk
Napsal: 22 bře 2016 12:04
od cmuch
Edit:
všim sem si, že už to řešíte i jende, kde je to řešeno suprově.
Tak tohle sem dám jen tak
Tak tady je makro co vloží nepodbarvené vagóny do nového listu
Kód: Vybrat vše
Sub VypisVagonu()
'
Dim shActive As Worksheet, shNevracene As Worksheet
Dim rngMyRange As Range
Set shActive = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
Set shNevracene = ActiveSheet
shActive.Select
Set rngMyRange = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
radek = 1
For Each cell In rngMyRange
If cell.Interior.Pattern = xlNone And cell.Value <> "" Then
shNevracene.Cells(radek, 1) = cell.Value
radek = radek + 1
End If
Next
End Sub