Příspěvky uživatele

Napr.:
If Not rngBunka Is Nothing Then Moja_Oblubena_Premenna = rngBunka.Row

Alebo do inkriminovanej časti doplnte:
On Error Resume Next
With ActiveSheet.Columns("K:K")
Moja_Oblubena_Premenna = .Find(What:="", After:=.Cells(Rows.Count), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=True).Row
End With
On Error GoTo 0

V oboch prípadoch definujte Moja_Oblubena_Premenna ako Long
Dim Moja_Oblubena_Premenna as Long

Aký Vám to vráti výsledok? Mne 0. A to je zle.

Napr.:
Sub Makro1()
Dim rngBunka As Range
With Application.FindFormat.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With

With ActiveSheet.Columns("K:K")
Set rngBunka = .Find(What:="", After:=.Cells(Rows.Count), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=True)
End With

If Not rngBunka Is Nothing Then rngBunka.Activate
End Sub

No a keby sa po vykonaní vašeho makra vymazal aj zoznam Undo ?
Sub makro()
Range("I1").ClearContents
ThisWorkbook.Saved = True
End Sub
Teda sa napr. vymaže nejaká nepotrebná bunka, čo zruší doterajšiu históriu Undo (lebo VBA nevytvára Undo), a nastaví sa príznak Saved.

V prípade, že sú rovnaké vždy po sebe, tak napr.:
=HYPERLINK(IF(COUNTIF(OBLAST_ODD;"KUCH")=0;"";"#A"&11+MATCH("KUCH";OBLAST_ODD;0)+COUNTIF(OBLAST_ODD;"KUCH"));"KUCH")
=HYPERTEXTOVÝ.ODKAZ(KDYŽ(COUNTIF(OBLAST_ODD;"KUCH")=0;"";"#A"&11+POZVYHLEDAT("KUCH";OBLAST_ODD;0)+COUNTIF(OBLAST_ODD;"KUCH"));"KUCH")
...
Ak nejdú po sebe tak napr. (maticový vzorec Ctrl+Shift+Enter):
=HYPERLINK(IFERROR("#A"&LARGE(IF(OBLAST_ODD="KUCH";ROW(OBLAST_ODD));1);"");"KUCH")
=HYPERTEXTOVÝ.ODKAZ(IFERROR("#A"&LARGE(KDYŽ(OBLAST_ODD="KUCH";ŘÁDEK(OBLAST_ODD));1);"");"KUCH")
...

OBLAST_ODD je Definovaný názov
='zoznam pacientov apríl'!$I$13:$I$500

Tak len z hlavy. Buď použite pri stlačení tlačítka (vypína všetky udalosti)
Application.EnableEvents = False
... vykonanie makra ...
Application.EnableEvents = True
alebo si urobte globálnu premennú v module
Public DisableActivate as Boolean
a pri stlačení použite
DisableActivate = True
... vykonanie makra ...
DisableActivate = False
pričom zároveň do Worksheet_Activate()
doplňte na začiatok
If DisableActivate Then Exit Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Name = Left$(Range("D4"), 31)
End Sub

Použil som polia, je to rýchle. Listy si rovno pomenujte vo VBA. V položke "Name" im dajte wsPoruchy a wsArchiv. Uchováva to zdrojovú tbl stále 10 riadkovú.
Sub kopiruj_a_vymaz()
Dim Radku As Long, Pocet As Long, LO As ListObject, PoleS(), PoleN(), i As Long, y As Long, x As Long, RNG As Range

Set LO = wsPoruchy.ListObjects("Tabulka38")
With LO.DataBodyRange

Pocet = WorksheetFunction.CountIf(.Columns(11), "Dokončeno") 'Zisti počet Dokončeno
If Pocet = 0 Then Exit Sub
ReDim PoleN(1 To Pocet, 1 To 11) 'Priprav veľkost poľa pre prenášané dáta podľa počtu Dokončeno
PoleS = .Value 'Načítaj dáta z Tabulka38
y = Pocet 'Index riadku od spodu

For i = 1 To UBound(PoleS, 1)
If PoleS(i, 11) = "Dokončeno" Then 'Hľadaj Dokončeno
For x = 1 To 11
PoleN(y, x) = PoleS(i, x) 'Prekopíruj dáta do nového poľa
Next x
y = y - 1 'Index o riadok vyššie
If RNG Is Nothing Then Set RNG = .Rows(i) Else Set RNG = Union(RNG, .Rows(i)) 'Pridaj do oblasti na zmazanie
End If
Next i

If Not RNG Is Nothing Then 'Ak je nejaká oblasť na zmazanie
Application.ScreenUpdating = False
If .Rows.Count - Pocet < 10 Then LO.Resize LO.Range.Resize(11 + Pocet) 'Ak bude po zmazaní menší počet riadkov v Tabulka38 ako 10, tak zväčši Tabulka38
RNG.Delete Shift:=xlUp 'Odstráň riadky

Set LO = wsArchiv.ListObjects("Tabulka2")
LO.DataBodyRange.Rows(1).Resize(Pocet).Insert 'Vlož potrebný počet riadkov do archívnej tabuľky hore
LO.DataBodyRange.Rows(1).Resize(Pocet).Value = PoleN 'Archivuj data
Application.ScreenUpdating = True
End If
End With
End Sub

Vložiť do modulu
Sub Skryt()
Dim wsSheet As Worksheet, bSkyt As Boolean

For Each wsSheet In ThisWorkbook.Worksheets
With wsSheet
bSkyt = .Columns("C:C").EntireColumn.Hidden = False
.Range("C1,AI1").EntireColumn.Hidden = bSkyt
.Range("A77,A80").EntireRow.Hidden = bSkyt
End With
Next wsSheet
End Sub

Skúste, či som to pojal správne.

Vymenil som pozíciu riadku "Rok" z riadku 3 na riadok 1, aby sa dal použiť VLOOKUP na nájdenie ceny a počtu Free Days v danom mesiaci daného roku. Tá preškrtnutá oblasť tam byť nemá (je zbytočná), ostatné musia korešpondovať s mesiacom v 6. riadku,

Zmenil som zadávanie tohto roku, teraz dáte iba do G1 prvý mesiac 1.6.2018 a ostatné sa dopočítajú.
Rovnako sa mesiac ťahá vzorcom aj do riadku 6. Aby sa zobrazilo iba to čo má, je použitý formát bunky.

Zmenil som vzorce v celej spodnej tabuľke, aj ich formát bunky, aby "--" dával formát a nie vzorec. Pre zjednodušenie pochopenia vzorcov som použil niekoľko Definovaných názvov ("CENA_V_MESICI", "DOBA_ZDARMA", "KONEC", "PLACENYCH_DNU_V_MESICI").

Ale!
Ale príde mi to nejako moc zložité. Dajte niekto niečo jednoduchšie.

To mi príde trochu nezmyselné. Modelový príklad:
-naskladním 29.4.2019
-vyskladním 20.5.2019
-počet dní zadara bude v 4/2019 - 14 dní (cena za deň 30)
-počet dní zadara bude v 5/2019 - 10 dní (cena za deň 20)
-Ako to budem počítať?
Totiž tých 14 dní zadara, ktoré platili v dobe naskladnenia (29.4.2019) by mali byť až do 12.5.2019.
Lenže v 5/2019 platí, že zadara je len 10 dní, teda do 10.5.2019. To ale odporuje podmienkam, aké boli pri naskladnení.
Rovnaký rozkol je v cene. Aká cena sa bude počítať od 1.5.2019 do 10.5.2019 (alebo do 12.5.2019 podľa toho ako sa rozsekne predošlí rozkol) ? A prípadne aká bude cena od 11.5.2019 - 12.5.2019 ?

Ak nemáte nový Office 365 s novou funkciou MINIFS a MAXIFS tak použite tú KT. ak to chcete vzorcom a bez matice, tak potom asi jedine tú maticu schovať do Definovaného názvu:
DEFMIN
=MIN(IF(TabData[sloučit]=data!$G2;TabData[Cena]))
=MIN(KDYŽ(TabData[sloučit]=data!$G2;TabData[Cena]))
DEFMAX
=MAX(IF(TabData[sloučit]=data!$G2;TabData[Cena]))
=MAX(KDYŽ(TabData[sloučit]=data!$G2;TabData[Cena]))
a v tabuľke použiť už nematicový vzorec
=DEFMIN
=DEFMAX
Alebo z tej KT cez GETPIVOTDATA načítajte výsledky do tej Vašej Tabuľky.
Všetko v prílohe.

Ak sa pozriete do prílohy, zistíte, že je to maticový vzorec (info doplním aj hore), a že je tam aj KT na ukážku.

Myslíte totok (maticový vzorec zadávame pomocou Ctrl+Shift+Enter) ?
=MIN(IF([sloučit]=[@sloučit];[Cena]))
=MIN(KDYŽ([sloučit]=[@sloučit];[Cena]))

=MAX(IF([sloučit]=[@sloučit];[Cena]))
=MAX(KDYŽ([sloučit]=[@sloučit];[Cena]))
alebo nejakú KT?

No pár chýb ste narobil, ale aj tak obdivujem, že ste sa vôbec pustil do dekódovania hrozne zložitých vzorcov.
Napr. Zmenil ste písmenko v CELKEM_INDEXY_VAD na CELKEM_INEXY_VAD, Boli tam použité v podmienkach ODDELENIE vs LIST, a ešte niečo čo som zabudol čo to bolo, to som odstránil ako prvé. Teraz sa zdá, že to funguje.

Skúste, či je to vončo...

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje