Příspěvky uživatele
< návrat zpět
Sheets(1).Protect Password:="heslo", UserInterFaceOnly:=True
Makru povolí všetko, ale list bude zamknutý. Netreba odomykať. Ale treba to urobiť vo Workbook_Open. Čo so sebou nesie zase nutnosť mať jeden VeryHidden list napr. s logom, ktorý pri uložení ako jediný nechá Visible, pri otváraní bude zobrazený teda len list s logom, pokým sa nepovolia makrá, v tom momente sa ostatné odokryjú a logo sa schová.
Skúste toto:
Sub Nastav()
Application.OnKey "{105}", "devina"
Application.OnKey "{103}", "sedma"
...
End Sub
Kódy by mali byť :
vbKeyNumpad0 96 0
vbKeyNumpad1 97 1
vbKeyNumpad2 98 2
vbKeyNumpad3 99 3
vbKeyNumpad4 100 4
vbKeyNumpad5 101 5
vbKeyNumpad6 102 6
vbKeyNumpad7 103 7
vbKeyNumpad8 104 8
vbKeyNumpad9 105 9
vbKeyMultiply 106 *
vbKeyAdd 107 +
vbKeySeparator 108 ENTER
vbKeySubtract 109 -
vbKeyDecimal 110 .
vbKeyDivide 111 /
Skúste aktualizovať Office, Windows, ovládače grafickej karty.
Office 2016 365 Click 2 Run (C2R) sa aktualizuje priamo v aplikácii, Súbor - Konto - Aktualizovať.
Office 2016 Pro sa aktualizuje cez Windows Update, kde musíte mať zaškrtnutú cca takúto vetu "Aktualizovať aj ostatné aplikácie Microsoft", či tak nejak.
Grafickú kartu aktualizujte:
a) na webe výrobcu PC
b) na webe výrobcu grafiky
Skúste najskôr za a).
Tak dá sa použiť to EVALUATE aj bez listu:
Sub pokus()
Dim Vysledok()
Vysledok = Evaluate("=GetA()&GetB()")
End Sub
Function GetA()
GetA = Array("a", "b", "c", "d")
End Function
Function GetB()
GetB = Array("m", "n", "o", "p")
End Function
Ide to aj na horizontálne aj vertikálne pole, ale ak by bolo potreba Transpose (či už v EVALUATE alebo v GetA), tak bude obmedzenie na počet 34464 prvkov. Samozrejmosťou je predpoklad rovnakých rozmerov polí.
Cyklus je ale rýchlostne nenahraditeľný, asi 10x rýchlejší. Takto som to testoval:
Dim arrA(), arrB()
Function SpojEvaluate() As Double
Dim Vysledok(), sta As Double, sto As Double
sta = Timer
Vysledok = Evaluate("=GetA()&GetB()")
sto = Timer
SpojEvaluate = sto - sta
End Function
Function GetA()
GetA = arrA
End Function
Function GetB()
GetB = arrB
End Function
Function SpojCyklus() As Double
Dim i As Long, u As Long, Vysledok(), sta As Double, sto As Double
sta = Timer
u = UBound(arrA)
ReDim Vysledok(1 To u)
For i = 1 To u
Vysledok(i) = arrA(i) & arrB(i)
Next i
sto = Timer
SpojCyklus = sto - sta
End Function
Sub VyplnPolia(u As Long)
Dim i As Long
ReDim arrA(1 To u): ReDim arrB(1 To u)
For i = 1 To u
arrA(i) = "A" & i: arrB(i) = "B" & i
Next i
End Sub
Sub Check()
Call VyplnPolia(100000) 'Počet prvkov polí
MsgBox ("Evaluate : " & SpojEvaluate & vbNewLine & "Cyklus : " & SpojCyklus)
End Sub
Jediné, čo ma napadlo bez cyklu je
1. krok prasknúť polia do listu (riadok pre každé pole, prípadné transponovanie v tom istom kroku)
2. cez EVALUATE spojiť stĺpce (výsledok bude pole)
Sub pokus()
Dim A(), B(), Vysledok()
A = Array("a", "b", "c", "d")
B = Array("m", "n", "o", "p")
Cells(1, 1).Resize(UBound(A) + 1) = WorksheetFunction.Transpose(A)
Cells(1, 2).Resize(UBound(B) + 1) = WorksheetFunction.Transpose(B)
Vysledok = Evaluate("=A1:A" & UBound(A) + 1 & "&B1:B" & UBound(B) + 1)
Cells(1, 3).Resize(UBound(A) + 1) = Vysledok
End Sub
Môžeme ale diskutovať, či nebude rýchlejšie to prehnať cez cyklus čisto v rámci VBA.
Tak len jednu k veci. AutoFit nefunguje pri zlúčených bunkách. Je potrebné dočasne použiť nejakú samostatnú bunku (kľudne na inom skrytom liste), ktorá bude mať šírku súčtu šírok zlúčených stĺpcov, a v nej urobiť AutoFit. A načítať potom novú výšku pre zlúčené riadky proporcionálne (teda ak sú zlúčené riadky o výškach 8 a 16, tak sa nová výška rozpočíta v pomere 1:2). Asi tak ...
Akurát že treba kontrolovať ktorá oblasť bola zmenená, a tú upravovať. No ak príde k výmazu, musí byť zase niekde uložená defaultná výška každého riadku (dvojriadku atď). Vidím to dosť komplikovane. Pri výmaze stránky to bude hardcore.
Nerozumiem teda, čo myslíte pod pojmom "upraviť kód". Ja by som to takto nerobil, ale toto je asi také nejaké podobné (aj s podobnými chybami ako neurčitý list, zbytočné Copy...):
Sub POKUS1()
Dim PoslRadek As Long
PoslRadek = Cells(Rows.Count, 2).End(xlUp).Row
Range("C5").FormulaR1C1 = "=SUMIFS(DATA!C[-1],DATA!C[-2],VYPOČET!RC[-1])"
Range("C5").AutoFill Destination:=Range("C5:C" & PoslRadek)
Range("C5:C" & PoslRadek).Copy
Range("C5:C" & PoslRadek).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
End Sub
No jedno riešenie pomocou maticových vzorcov je napr. takéto, ale je veľmi výpočtovo náročné. Treba vymyslieť niečo iné, možno nejaké pomocné stĺpce, makro, ...
Len upresním, či som to pochopil. Ak je v posledný dátum daného ID jeho stav 0, teda je neaktívny, znamená to, že vypíšeme tento posledný dátum celkovo pre dané ID ako END, a aj prvý dátum celkovo pre dané ID ako ŠTART.
Ak je ale v posledný dátum daného ID jeho stav 1, teda je aktívny, znamená to, že vypíšeme tento dátum ako ŠTART, a END dátum je nič.
Iný pr.:
Sub Vypln()
With ThisWorkbook.Worksheets("VYPOČET")
With .Cells(5, 3).Resize(.Cells(Rows.Count, 2).End(xlUp).Row - 4)
.FormulaR1C1 = "=SUMIFS(DATA!C[-1],DATA!C[-2],RC[-1])"
.Value = .Value
End With
End With
End Sub
príp.:
Sub Vypln2()
With ThisWorkbook.Worksheets("VYPOČET")
With .Cells(5, 3).Resize(.Cells(Rows.Count, 2).End(xlUp).Row - 4)
.Value = Evaluate("=IFERROR(SUMIFS(DATA!$B:$B,DATA!$A:$A,$B5:$B" & .Rows.Count + 4 & "),"""")")
End With
End With
End Sub
Bodla by príloha.
A koľko tých riadkov tam bude asi väčšinou zaplnených, a koľko z nich asi bude vyhovovať? Ide o to, že či bude rýchlejší filter, porovnávanie poľa, či Find ...
Akurát netuším, ako to chcete radiť (zoraďovať). Neviem, koľko budete mať riadkov, ale myslím, že keby sa to malo nasadiť na veľké množstvo dát + zoraďovanie vzorcom (kde sa X-krát počíta to isté), tak to bude výpočtovo neúnosné...
Ale asi som si mal radšej na dobrú noc klepnúť po paprči :)
Príklad...
Tie Vaše makrá som Vám tam nechal, len som pridal makro Najdi.
Môj názor : Celý problém je v jery-m.
-bez prílohy
-vágne podanie (čo znamená "Nepomohlo"?, hádže chybu 1004 alebo nepodáva očakávaný výsledok?)
-neodpovedanie na otázky (13.10.2017 11:51)
Podľa mňa to, na čo sa pýta, teda "co je špatně na tomto příkazu", má zodpovedané - špatně je L vs J.
A teraz je jedno či priamo alebo nepriamo cez set rng. Ak mu to nefunguje (chybová hláška) priamo ani nepriamo, tak môže byť problém v dátach. Napr. zlúčené bunky alebo čo ja viem. A to súvisí s 1. jeho chybou - bez prílohy.
A čo nepomohlo? Zmena rozsahu z A1:J792 na A1:L792, alebo zmena Array(2, 3, 6, 7, 8, 12) na Array(2, 3, 6, 7, 8) ? U mňa funguje aj jedno aj druhé. Priložte prílohu.
Tipujem : 12. stĺpec je L, a rozsah máte A:J.
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články