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