Jak vytáhnout data podle zabarvení buněk

[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 :)

[Reklama]

[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.

[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.

[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