• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$1" Then PageSetup.LeftHeader = _
"Příloha č. 3 ke Kolovadlu č. " & CStr(Range("E1").Value) & " IPP" & _
Chr(10) & "&""-,Bold""Přehled vydaných částek Sbírky zákonů s obsahem za dané období"
End Sub

Vravíte ľavý, píšete pravý (RightHeader).

Ak bude hodnota v E1 počítaná vzorcom, tak to fungovať nebude, lebo vzorcom vypočítaná hodnota nevyvolá procedúru Worksheet_Change.
Preto som vravel, že by sa aktualizácia hlavičky mala urobiť pri inej príležitosti. Na čo je hlavička aby bola hlavne pri tlači na stránkach. Tak preto som navrhol, aby sa pred tlačou aktualizovala (Workbook_BeforePrint). Prípadne, ak nie, navrhol som, aby sa aktivovala zmena hlavičky pri prepnutí medzi listami na daný list. Alebo proste pri inej príležitosti. Alebo si urobte tlačítko.

Vzorec totiž vyvolá procedúru Worksheet_Calculate, ktorá je Vám na nič, lebo v nej nieje možné meniť hlavičku.

Príklad čisto počítaného rozsahu bez filtra, na základe dátumov od-do v bunkách J1-K1:
=OFFSET('tisková sestava'!$A$1:$D$1;MATCH('tisková sestava'!$K$1;'tisková sestava'!$B:$B;1)-COUNTIFS('tisková sestava'!$B:$B;">="&'tisková sestava'!$J$1;'tisková sestava'!$B:$B;"<="&'tisková sestava'!$K$1);;COUNTIFS('tisková sestava'!$B:$B;">="&'tisková sestava'!$J$1;'tisková sestava'!$B:$B;"<="&'tisková sestava'!$K$1))

=POSUN('tisková sestava'!$A$1:$D$1;POZVYHLEDAT('tisková sestava'!$K$1;'tisková sestava'!$B:$B;1)-COUNTIFS('tisková sestava'!$B:$B;">="&'tisková sestava'!$J$1;'tisková sestava'!$B:$B;"<="&'tisková sestava'!$K$1);;COUNTIFS('tisková sestava'!$B:$B;">="&'tisková sestava'!$J$1;'tisková sestava'!$B:$B;"<="&'tisková sestava'!$K$1))
máte ich zoradené, dá sa teda aj takto.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B:P")) Is Nothing Then Call MacroDatum(Intersect(Target.EntireRow, Columns(1)))
End Sub

Sub MacroDatum(ByRef Target As Range)
Dim RNG As Range

If Target.Cells.Count > 1 Then
On Error Resume Next
Set RNG = Target.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
Else
If IsEmpty(Target) Then Set RNG = Target
End If

If Not RNG Is Nothing Then
Application.EnableEvents = False
RNG.Value = Date: Set RNG = Nothing
Application.EnableEvents = True
End If
End Sub

Sú tam spomínané aj 2013 a 2016. Ja mám 2016, túto KB nemám, ale Excel mi kolabuje aj niekoľkokrát za týždeň. Katastrofa, takéto veci sa mi v 2013 a 2010 nestávali Doba pokročila, no ...

Ešte by sa to dalo riešiť pred tlačou, alebo pred uložením
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Call UpravitHlavicku("Hárok1", "C16")
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call UpravitHlavicku("Hárok1", "C16")
End Sub

Sub UpravitHlavicku(List As String, Bunka As String)
With Worksheets(List)
.PageSetup.LeftHeader = CStr(.Range(Bunka))
End With
End Sub
prípadne pri Workbook_Open() alebo Worksheet_Activate().

Riešenie hry Block Puzzle

Premazávam disk a našiel som omylom niečo, čo som robil kedysi pre manželku, a už dávno som to sem chcel dať. Je to už deviata verzia vzniklá 1/2016, ktorá vznikala neustálym prerábaním predošlých verzií (raz súradnicový systém - pole, potom lineárny - string ...), a tak je kód katastrofa. Radšej sa k nemu nepriznám . Ale prerábať to nemienim, kafre naň pes, pretože funguje na 100 %. Neviem, čo by som s tým robil, a tak to dávam sem.

A čože to robí ? Rieši našu obľúbenú hru na mobile - Block Puzzle (a 100 iných názvov).

Ak Vás teda šľaktriafa pri tom, že Vám to nejde uložiť, nič to, za pár sekúnd máte vyriešené

Takto ? Vyfiltrujete si dátumy, a rozsah bude vždy začínať 1. riadkom (resp. 2. keď 1. je hlavička), lebo ide o filter, no dynamicky sa počíta počet čísel v stĺpci s dátumom (lebo dátum je číslo), plus nechajte nezaškrtnuté "Prázdne". A ak to myslíte tak, že sa vytlačí buď zadaných/vypočítaných počet riadkov, alebo počet vyplnených riadkov, tak sa berie v úvahu Min hodnota z týchto dvoch veličín. Na to je vo vzorci MINR, ktorú si teda odkazujte na tú Vašu vypočítavanú hodnotu, a ak chcete všetky riadky, tak jej dajte hodnotu 500 (alebo 1 000 000) a menšia bude tá zaplnená. Snáď ma chápete.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$16" Then PageSetup.RightHeader = CStr(Range("C16").Value)
End Sub

no a s ďalším textom spolu
... PageSetup.RightHeader = "abc " & CStr(Range("C16").Value)
Jáj, a zápätie/päta (zápatí) bude RightFooter namiesto RightHeader.

Vľavo je LeftHeader/LeftFooter a v strede zase CenterHeader/CenterFooter.

Ak hrozí, že bude hromadná zmena dát (kopírovanie) zároveň s bunkou C16, treba ošetriť nasledovne:
If Not Intersect(Target, Range("C16")) Is Nothing Then ...

Ak má byť kontrola na základe hodnoty menenej vzorcom, tak Worksheet_Change nepomôže, a to bude problém, pretože v Calculate metóde nieje možné nastavovať hlavičku/pätu.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B:P")) Is Nothing Then Call MacroDatum(Target)
End Sub

Sub MacroDatum(ByRef Target As Range)
Intersect(Target.EntireRow, Columns(1)).Value = Date
End Sub

Ešte ma napadlo priložiť jednoduchší vzorec pre prípad, že budú ID vždy za sebou. Vyberte si...

Alebo makrom. Zatiaľ je urobené tak, že sa počíta s tým, že sú oba stĺpce vedľa seba, a tabuľka má len 2 stĺpce. Dá sa poriešiť inak...

vzorcom iba komplikovanejším, v skrytom stĺpci. Ale zato môžu byť rozhádzané, nemusia byť za sebou.

Inak v jednom prípade vravíte že pri 5 sa použije E2-D2, a potom že sa pri 5 použije MD-D (čo zodpovedá presnému opaku D2-E2)
Označte si celé stĺpce a zrušte formátovanie nastavením na Všeobecné alebo Číslo na 2 desatinné.
Spomínaný vzorec od eLCHa Vám musí fungovať, len sa rozhodnite, či D2-E alebo E2-D2 bude pre 5-ku, teda prvý parameter, alebo ako druhý parameter.
=IF(LEFT(B2;1)/1=5;D2-E2;E2-D2)
=KDYŽ(ZLEVA(B2;1)/1=5;D2-E2;E2-D2)
nemôže byť problém ...

Príklad:
Sub OdstranSloupce()
Dim i As Integer, rngDEL As Range, Radek()
Const HDN = 999
With Worksheets("Data")
Radek = .Range("A36:Z36").Value
For i = 1 To UBound(Radek, 2)
If Radek(1, i) = HDN Then
If rngDEL Is Nothing Then Set rngDEL = .Columns(i) Else Set rngDEL = Union(rngDEL, .Columns(i))
End If
Next i
If Not rngDEL Is Nothing Then rngDEL.Delete: Set rngDEL = Nothing
End With
End Sub

A čo Vám na tom nefunguje ? Veď to máte tak, ako potrebujete, nie ?

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse