Příspěvky uživatele

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 ?

Hovoríte o CB v liste alebo vo VBA ?

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje