Maličká úprava na začiatku algoritmu, plus ešte jeden algoritmus iný. Testoval som oba na rovnakej vzorke 500 súborov :
na RAMdisku
1. variant (s vkladaním vzorca) - 2,3 sekundy
2. variant (s ExecuteExcel4Macro) - 1,8 sekundy
na HDD (7200 rpm)
1. variant (s vkladaním vzorca) - 1,8 sekundy
2. variant (s ExecuteExcel4Macro) - 1,4 sekundy
na SSD disku
1. variant (s vkladaním vzorca) - 2,3 sekundy
2. variant (s ExecuteExcel4Macro) - 1,7 sekundy
Testy som robil niekoľkokrát, a vyšli na prvý pohľad naozaj veeeľmi zvláštne. Teoreticky by mala byť rýchlosť najlepšia na RAMdisku, potom na SSD, potom na HDD. Najlepšie mi ale vyšiel HDD, pretože SSD je sytémový (momentálne 134 procesov, a to je už optimalizovaný), RAMDisk je používaný ako cahce pre 3 prehliadače ... (+ automatická záloha). A HDD (ten konkrétny kus) je najmenej namáhaný. Je krásne vidieť, že na rýchlosť vplýva všetko.
Otestujte si, a vyberte si.
PS: Merané len tak od oka stopkami.
A odkiaľ zoberieme ten link ? Ak ste mysleli toto, tak opäť zbytočná doterajšia práca, so zoznamom ...
Prosím Vás popíšte presne krok za krokom čo chcete presne dosiahnuť. Ale naozaj krok po kroku, napr. :
-v liste start zapíšem do A1 nejakú hodnotu
-kliknem na tlačítko, a vytvorí sa mi list s názvom, ktorý je o 1 väčší ako číslo v AX1, pričom sa toto číslo tiež zväčší
-do bunky A2 v liste start sa vloží toto nové číslo, rovnako ako aj do bunky A2 v novovytvorenom liste
-chcem zostať prepnutý na novom liste
-zároveň chcem, aby keď sa prepnem znovu na list start, a stlačím tlačítko, aby ma preplo na list ktorého názov je v A1 uvedený ak existuje, ak neexistuje, tak nech ho vytvorí, a prepne ma naspäť na list start
-...
Takto to prosím Vás popíšte. V tom Vašom kóde nemáte definované premenné, nieje vôbec jasné, kedy na ktorý list zapisujete, Odkazujete sa na bunku Cells(1,7) v ktorej ale nič nieje, a ani tam za celú dobu behu makra nič nevkladáte - čiže automaticky to končí chybou. Navyše v kóde je divná podmienka, keď NazevListu sa získava v podmienke, ale zapisuje sa do bunky Cells(1,5) aj mimo podmienku.
... Celý kód je podľa mňa prinajmenšom divný.
Už som sem dával riešenie podobného problému. Viete si to upraviť?
http://wall.cz/index.php?m=topic&id=24791
Ak nie, tak by som Vám to snáď zajtra spáchal. Ten "seznam" má byť ako list alebo ako Výberový zoznam v bunke, a to v nejakom novom súhrnnom zošite ?
EDIT: Posielam nejaký ten návrh.
A ešte otázka, koľko tých súborov v adresári asi bude ?
Z tabletu, takže iba typ:
Toto nefunguje ?
Me.Image1.Picture = LoadPicture(Worksheets("Hárok1").Cells(2,1).Value)
Kde Image1 je objekt Obrázok na forme.
EIDT: A ešte by som ošetril volaciu procedúru :
Sub Tlačidlo1_Kliknúť()
On Error Resume Next
UserForm1.Show
If Err <> 0 Then
MsgBox ("- chybný formát obrázku," & vbNewLine & "- neexistujúci obrázok," & vbNewLine & "- alebo iná chyba pri jeho načítaní")
Exit Sub
End If
On Error GoTo 0
End Sub
pretože stačí aby bola chyba v názve, či nesprávny formát a havaruje to - samozrejme.
A ešte drobnosť, PictureSizeMode by som dal na fmPictureSizeModeZoom, v prípade ak sa nevie aký pomer strán alebo veľkosť budú mať tie obrázky.
Tento najnovší kód už Head1 zmaže, ale opäť iba raz. Opätovné použitie stále nefunguje ani ostatné Heads.
Neviem či som to tu niekde včera písal, alebo som na to len myslel ... akákoľvek nepresnosť pri zadaní môže spôsobiť zbytočnú prácu tých čo tu pomáhajú. Lenže to asi nemá riešenie, keďže človek ako taký, sa nedokáže vcítiť do "kože" druhého, aby uhádol aj to čo je pre dotazujúceho samozrejmosť, a opačne. Preto tu teraz diskutujeme, myslím že aj tak zbytočne. Vyvíjame 2 varianty, lepšie by bolo vyvinúť jeden, ale najlepší pre užívateľa. Užívateľ nech si otestuje v reále, nech dá vedieť. No veď niečo spoločnými silami už len spáchame
@marjankaj:
Nechcem sa dohadovať (strata času), tak krátko:
-Head1 sa má mazať rovnako ako ostatné. Myslel som na to hneď v prvom príspevku (otázka 2). Odpoveď je jasná - ÁNO mazať.
-Na môj prvý súbor ? Dal som iba jeden, a ten fungoval tak, ako boli do tej doby keď som ho postoval špecifikované požiadavky. Ak sa pridala požiadavka na nemazanie v prípade kompletného zaplnenia, pripísal som len potrebnú podmienku.
-Je šuma-fuk koľko riadkov, ale dotyčný písal do 150 riadkov = no problém (maximálne dočasne vypnúť ScreenUpdating). Každopádne, ak by spomenul, že to chce na 20000 Rows, tak určite nie takto, ale cez pole, a jedno načítanie a jeden zápis celého poľa naraz. Ale o tom nebola reč.
-Stačí keď Vám v kóde akokoľvek uhladenom a krátkom nefunguje jedna jediná vec, tým pádom kód proste nefunguje. A to som napísal. Často stačí iba jediná drobná podmienka od uživateľa, a kód sa znásobí do dĺžky aj komplikovanosti.
-Vo Vašom novšom kóde, rovnako nieje vyriešený problém odstránenia Head1 - takže opäť nefunguje, nech je akokoľvek krátky. Elegantná metóda xlDown a spol, sa niekedy nedá jednoducho použiť.
-Tento nový kód dokonca akonáhle raz zapíše hodnoty do Head5, ďalšie spustenie už nič neurobí. Ďalšie posledné hodnoty už proste neposunie.
Pripravil som novú verziu, ak by si uživateľ prial napr. zmazať riadky, kde už nič nieje, tak napr. takto.
Presne takto jednoducho - to nefunguje. Head1 tam stále necháva, nikdy ho nezmaže, aj keď to je podmienka. Preto som to trochu "zkomplikoval". Pretože ak to urobíme tak, aby sa zmazal Head1, tak ako sa má, tak nám ostane v Head5 posledný záznam. Ten by rovnako nebol nikdy zmazaný. Preto som tam musel dať kontrolu celej šírky oblasti na posledný riadok. Aby sa aj toto eliminovalo.
Tak isto tento Váš kód nefunguje, keď sú zaplnené Head1 až Head4. Pretože vtedy xlToRight vracia odkaz na Head5, kde je výsledok. Čiže vystrihne výsledok a vloží ho na to isté miesto, na výsledok. Neberie poslednú hodnotu, čiže Head4.
...
EDIT:
@Michal_85:
Iba vymeniť
Cells(i + 1, Posl) = blank
za
If Posl <> 4 Then Cells(i + 1, Posl) = blank
Nech sa páči.
Najskôr som myslel, že to má byť hneď pri zmene nejakej bunky, preto som vravel, že to nemá logiku, lebo by sa nikdy nič iné okrem práve zapísanej bunky, nepresunulo. Na tlačítko to už zmysel má.
No to je zasa popis. Takže otázky:
1. V Head1 sú vždy data ? Teda sa dá považovať riadok za zaplnený keď sú v tomto stĺpci data ?
2. Tento stĺpec Head1, ak je ako jediný zaplnený, tiež sa má "posunúť" do stĺpca Head5, tak ako stĺpce Head2, Head3, Head4?
3. Čo znamená to "posunúť" ? Ak to, že sa skopíruje posledná bunka z rozsahu Head2-Head4 (príp. Head1-Head4 viď vtššie) do bunky Head5, tak OK. Ak ale "posunúť" znamená presun, tak to znamená, že nikdy sa nedostaneš na ďalšiu bunku. Napr. zistíme zápis do Head3, a toto presunieme do Head5, čiže Head3 je opäť prázdna. Na Head4 sa teda ani nedostaneš (za predpokladu že pôjdeš doradu)
...
Presne tak, všetky premenné musia mať rovnaký typ, alebo musia byť na rovnaký typ retypovateľné. A to číslo -1 nieje. Inak by to boli klasické jablká a hrušky.
Ktorú verziu toho môjho návrhu používate ? V novších verziách to vyhodí zoznam nulových produktov IBA ak v nejakej bunke (čiže v Excely to väčšinou znamená v aktívnej bunke) nastane 0. Ak je tam X núl, ale práve sa nejaká hodnota na 0 nezmení, tak nič nevypíše.
Snažím sa dešifrovať, čo ste napísali. Takže vy teraz chcete, aby keď nastane 0, sa nevypísal zoznam nulových produktov, ale aby napísanie 0, spôsobilo odčítanie jednotky od neviem odkiaľ ? Neviem ako sa dá odpočítať 1 od počtu ks, keď práve ten počet ks, som práve zmenil na 0.
Skúste to prosím povedať nejako inak.
A prečo nám to sem nenapíšete. Od nás chcete odpovede, ale o svoje sa nepodelíte. No no no
Inak takto:
Application.CommandBars("Ply").Enabled = False
Do modulu dajte:
Sub RightClick()
Dim WS As Worksheet, i As Integer
Dim oMenu As CommandBar, oItem As CommandBarControl
Set oMenu = CommandBars.Add("", msoBarPopup, , True)
For Each WS In Worksheets
Set oItem = oMenu.Controls.Add
oItem.Caption = WS.Name
oItem.OnAction = "'Vyber """ + WS.Name + """ '"
Next WS
oMenu.ShowPopup
End Sub
Sub Vyber(WS As String)
Worksheets(WS).Activate 'Nejaká Vaša činnosť s vybraným listom
End Sub
Do ThisWorkbook dajte toto :
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
RightClick
Cancel = True
End Sub
Pri Pkliku na ktoromkoľvek liste Vám dá na výber zo zoznamu všetkých listov, a vykoná procedúru Vyber, v ktorej si už ošetrite ako potrebujete. Parameter WS v nej obsahuje názov zvoleného listu v kontextovom menu.
Len na okraj:
Ak je to ten zošit "Protokol_o_hlaseni_poruchy" z iného príspevku, tak urobte:
Zmente si v "Datový list" hodnoty dátumov z "1.". "2.", "3.", ... na 1,2,3 (proste bez bodiek).
V tomto liste zmente formát bunky s dátumom na Vlastný dd.mm.yyy (v CZ asi dd.mm.rrrr), a aj vzorec na výpočet dátumu na :
=DATE(Protokol!D8;Protokol!C8;Protokol!B8)
Zmente si v Databáza celý stĺpec Datum na formát Vlastný dd.mm.yyyy (CZ viď vyššie)
Na liste Protokol zmente formát Den a Mesiac na Vlastný General"."
Overenie údajov v Deň dajte na reálne možné dni :
=OFFSET('Datový list'!$G$2:$G$32;;;DATE(D8;C8+1;1)-DATE(D8;C8;1);1)
Tu by bolo ešte dobré v makre dorobiť úpravu, keď napr máte v roku február s 29 dňami, a zmeníte rok na rok kde je 28, tak Excel aj keď má správne vypoťítaný rozsah čísel predošlým vzorcom, tak v prípade prekročenia to najvyššie možné automaticky nevloží.
A ten Váš vzorec na výpočet počtu výskytov, neviem síce ako funguje (odkiaľ berie vstupné dáta na filter), tak by mohol vyzerať upravený pre vstup z buniek aj takto
=COUNTIFS(Databáze!$A:$A;$C$1&"*";Databáze!$C:$C;">"&DATE($D$8-1;12;31);Databáze!$C:$C;"<"&DATE($D$8+1;1;1))
kde si za $C$1 dosadte bunku s hľadaným textom, a za $D$8 si dosadte bunku s hľadaným rokom.
Len toľko na margo...
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.