Můžete tu přílohu dát sem?
Ulozto mám blokované
@cmuch
Odbočím s vámi ;)
Protože vás považuji za šikovného v excelu a proto očekávám, že nebudete používat takové prasečiny, jako obarvování textu barvou pozadí, když zcela jistě znáte vlastní formát ";;;" ;))
Zkuste si nastavit bílý text a pak stránku vytisknout černobíle nebo si zkuste bílý text prostě jen označit, atd atd.
Příloha?
[ss]
a nebo to prostě přepočtěte.
@adosl
Rád bych vám pomohl, ale nejsem si jistý, jestli si tu pomoc zasloužíte. Tato příloha už tu byla, nejsem slepý. Jenže vy mluvíte celou dobu o listu vzorec a několika listech kterých se to týká a dalších listech, kterých se to netýká. A pak vložíte tohle.
Prosím, važte si našeho času a připravte tu přílohu pořádně, pak vám někdo odpoví - já už to nebudu.
@ladaakk
Napadla mě taková blbost. Co kdyby se to řešilo podmíněným formátováním pomocí vzorce. Pokud je splněna podmínka tak barva písma bude barva pozadí.
Škoda, že není středověk. Za tohle bych vás z radostí nechal upálit. ;))
@cmuch
@ladaakk
další z možných řešení
A vám bych k tomu ještě přidal doživotní žalář. Sice by to nebyl velký rozdíl, ale třeba by to někoho odradilo. ;))
Fujtajxl
Bez urážky, ale myslím, že jste jen popletený ;)
Kdyby jste sem dal přílohu, tak už to máte dávno funkční.
Co znamená z jiného listu
Když se mi z jiného listu přepíše do buňky E1 číslo 5
@Palooo
asi byste nejdříve měl odkrýt skrytéRows("8:14").EntireRow.Hidden = false
Rows(7 + Range("E1").value & ":14").EntireRow.Hidden = trueDo buňky "E1" dejte ověření, že musí být celé číslo od 1 do X
Mimochodem - pokud proceduru Skryj budete volat pouze s jediné procedury v projektu, nemusíte ji mít definovanou zvlášť na modulu, ale můžete rovnou vložit do událostní procedury Change - tedy:Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("B1").Address Then
Dim sh As Worksheet, r As Range
For Each sh In ThisWorkbook.Sheets
On Error Resume Next
For Each r In sh.Range("Skryj1_3").Rows
r.EntireRow.Hidden = r.Cells(1).Value = ""
Next r
On Error GoTo 0
Next sh
Set r = Nothing
Set sh = Nothing
End If
End Sub
Já už rozumím.
Musíte si uvědomit, že ta měněná buňka je na listu "vzorce", takže ta událostní procedura musí být v jeho modulu. Tam tedy umístěte proceduruPrivate Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("B1").Address Then
Call Skryj
End If
End SubPokaždé, když změníte hodnotu v buňce B1, se tato procedura spustí a zavolá proceduru Skryj
No a pak do modulů vybraných listů u kterých je ale proměnlivý název, takže dopředu nedokážu říct jak se bude který list jmenovat potřebuji vložit něco co mi při změně buňky B1 v listu vzorce spustí na tom konkrétním vybraném listu makro Skryj()
Nemůžete do jiného listu umístit událostní proceduru hlídající změnu v jiném listu (max do modulu sešitu, ale to by v tomto případě nepomohlo)
Takže musíte proceduře Skryj říct, ve kterých listech má skrývat a ve kterých ne. Tady je více možností, já navrhuji na každém s dotyčných listů definovat vždy stejný název (např.: "Skryj1_3") s platností pouze pro list (tedy "'NazevListu'!Skryj1_3") a pak spustit cyklus s testem na existenci tohoto nazvu na listu. V tomto případěSub Skryj()
Dim sh As Worksheet, r As Range
For Each sh In ThisWorkbook.Sheets
On Error Resume Next
For Each r In sh.Range("Skryj1_3").Rows
r.EntireRow.Hidden = r.Cells(1).Value = ""
Next r
On Error GoTo 0
Next sh
Set r = Nothing
Set sh = Nothing
End Sub
Psáno z brucha, netestováno.
Poznámka: Dělá to to samé, co to vaše původní makro, ale navíc je jedno, kde se v listu oblast "Skryj1_3" nachází a kolik má řádků.
Nebudu komentovat to makro (čímž jsem ho vlastně okomentoval ;)) )...
Vůbec vám nerozumím - jak chcete vkládat makro do listu?
Já si teda vůbec nejsem jistý jestli rozumím, ale v rámci probuzení buněk mozkových jsem to zkusil
Do buněk dejte vzorec=(ROK(DNES())&"-"&List1!$B$1&"-"&ŘÁDEK())/1Ten, pokud datum neexistuje, vyhodí chybu a toho využijeme v kóduPrivate Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If Not sh.Name = Target.Parent.Name Then
With sh.Range("A1:A31")
.EntireRow.Hidden = False
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Hidden = True
On Error GoTo 0
End With 'sh.Range("A1:A31")
End If
Next sh
Set sh = Nothing
End If
End Sub
Viz příloha
@marjankaj
ten můj poslední příspěvek nebyl řešením problému Martina1až8, ale pouze jsem chtěl upozornit, že nemusíte používat cyklus (schválně jsem nedefinoval With - End With). Jednoduchou úpravou by se dalo nahradit .EntireRow.Delete za RelevantniBunky.Delete Shift:=xlUp
Nicméně posouváním řádků nahoru byste musel řešit minimálně problém s formátováním buněk na konci tabulky. Taky pod tabulkou může být další tabulka nebo se na ni mohou (pravděpodobně ne v tomto případě) odkazovat jiné buňky pomocí vzorce a pak je to nepoužitelné. Takže toto může být řešením pro více lidí.
Spíše by mě zajímalo, co byl za problém s těmi 4 řádky ;)
@marjankaj
kdyby to šlo jen odstranit, nepotřebujete cyklus. Stačí 2 řádky kódu.
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
netestováno, ale věřím, že by fungovalo
Tak snad jsem se přiblížil alespoň trochu k vaší představě.
Zkoušel jsem na příloze
17363_sumsheet_3364784813-kousek.zip
Otestujte a případné dotazy pokládejte rychle, než zapomenu jak jsem to dělal.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.