Zpracování pár tisíc řádků by ve vba nemělo trvat víc jak několik vteřin.
Součástí maker je kumulativní aktualizace listu. To se v power query nedělá snadno, bylo by nutné spojovat dva světy. Úprava maker by nemusela být až tak složitá.
Hlavní? problémy maker, pár příkladů.
1. Zbytečný a časově drahý kód
* filtr čísel ve sloupci K - proč to neudělat v sql dotazu??? Dotaz může data také seřadit.
* sub OznacKArchivaci je zbytečná. Řádky už označeny jsou - v "O" je "Uzavřeno"
* Používání metody Aktivate a Select je v naprosté většině případů zbytečné (a pomalé)
* Nesmyslný kód. Ve funkci Najdi:
For Each Bunka In Selection
jmeno = Bunka.Value 'uloz do promene
bun = Bunka.Address
Next Bunka
Tenhle kód si zapamatuje adresu a obsah poslední buňky ve výběru. Smysl nechápu.
* zase v Najdi:
Vyhoď Application.ScreenUpdating = True
Tady to povolí zobrazení po každém hledání...
Zkontroluj i ostatní funkce. To má být jen tak, kde je to opravdu nutné (na konci obsluhy tlačítka).
2. Pomalé operace
* identifikace objektu "proléza" pokaždé celý strom objektů (pomalé). Místo:
ThisWorkbook.Worksheets("souhrn").Activate
For i = Range ...
If Cells(i, 1) ...
používej With např.:
With ThisWorkbook.Worksheets("souhrn")
For i = .Range("B"...
If .Cells(i, 1 ...
Mimochodem, i takový kód je také dost pomalý.
* procházení buněk pomocí Cell.Offset(1, 0).Select - použij index řádku, nebo metodu .Find, nebo ještě lépe nahraj data sloupce do pole a pak hledej v tomto poli (při dobrém kódu to je v nejhorším případě stejně rychlé, jako Find),
3. Pomalé algoritmy.
* Mazaní, kopírování - doba málo závisí na velikosti bloku, ale hodně na jejich počtu -> je výhodné seskupit archivované řádky do jednoho bloku -> setřídit tabulku tak, aby mazané/kopírované řádky byly v co nejmenším počtu bloků a ty pak vyšejit jediným příkazem.
* Nesmyslný kód:
Set Naj = Sheets("souhrn").Range(sadre).Find(What:=jmeno, SearchOrder:=xlByRows) 'hledá označené HNV
P001 = Sheets("souhrn").Range(Naj.Address).Offset(0, 1).Value 'vytvořeno
P002 = Sheets("souhrn").Range(Naj.Address).Offset(0, 17).Value 'množství
Raději?
Set Naj = Sheets("souhrn").Range(sadre).Find(What:=jmeno, SearchOrder:=xlByRows) 'hledá označené HNV
' + ošetření chyby
With Naj
P001 = .Offset(0, 1).Value 'vytvořeno
P002 = .Offset(0, 17).Value 'množství
nebo ještě rychleji
Dim data() As Variant
' hledej HNV
Set Naj = Sheets("souhrn").Range(sadre).Find(What:=jmeno, SearchOrder:=xlByRows) 'hledá označené HNV
If Naj Is Nothing Then GoTo Konec ' Konec najdi.
data = Naj.Resize(1, 68).Value
P001 = data(1, 2) 'vytvořeno
P002 = data(1, 18) 'množství
1. Pokud vzorec nefunguje po přidání 2. funkce index, tak je chyba tam.
2. AND(něco; něco jiné;...; 0) je buď CHYBA nebo NEPRAVDA
3. Když tvoříš podobné obludy, tak je aspoň slušně formátuj. (řádky/odsazení)
Použijte kontingenční tabulku a seskupte řádky podle roku a měsíce. Excel to udělá automaticky.
Zkuste zaguglit, třeba
https://www.google.com/search?q=longest+common+substring+problem+vba
A něco či vyberte.
Tak jak to popisujete, je to dost obecné. Podobné počítání s velkým objemem dat podmíněnému formátu moc nesvědčí. Vzorec by možná šel, ale při obecném zadání vznikne zase obluda.
Pokud to má rozumně fungovat, je nutné upřesnit zadání. Jinak tu bude zase řada zpráv "... je to skvělý, ... ale ještě drobnost....".
Co třeba použít kontingenční tabulku?
Johan-Kraczmar napsal/a:
Lubo, nějak mi to nechce sežrat to UNIQUE :-(
Pokud máte novější verzi excelu, pak
=LET(tab;FILTER($A$1:$A$6;$A$1:$A$6<>0);INDEX(tab;RANDBETWEEN(1;POČET(tab))))
1) Pokud to má být oddělené tak podmínky jsou:
víkend : =WORKDAY(C8-1;1)<>C8
svátek : =WORKDAY.INTL(C8-1;1;"0000000";Tabulka3[Datum])<>C8
=SUMA(SVYHLEDAT(UNIQUE(A2:A15);A2:C15;3;0))
@elninoslov
Čas odpovídá. Hlavní činností je načítání dat.
Tady se každý soubor načítá minimálně 2x. Neměřil jsem to, není to kritické. (V jiném případě jsem viděl i 10 čtení.) Dá se to zrychlit, ale za cenu složitějšího kódu.
Obvykle dávám přednost kratšímu kódu s jednodušší údržbou a čas řeším, až když to trvá opravdu dlouho (např. soubor má několik mil. řádků).
Možná jiná forma zápisu by mohla být čitelnější?
Tohle je načtení jednoho souboru a výpočet příslušné statistiky.
(Zadání je pro mne docela zmatečné, tak jen co je v přikladu nebo v poznámkách.)
// Statistika (funkce)
(Soubor as binary) =>
let
// Načtení dat
Zdroj = Lines.FromBinary(Soubor, null, false,1250),
DataTabulky = List.RemoveLastN(List.RemoveFirstN(Zdroj, each not Text.StartsWith(_, "Date") ), each not Text.StartsWith(_, ">") ),
#"Převedené na tabulku" = Table.FromList({"> " & DataTabulky{0} } & List.Range(DataTabulky,1), Splitter.SplitByNothing(), null, null, ExtraValues.Ignore),
#"Rozdělit sloupec oddělovačem" = Table.SplitColumn(#"Převedené na tabulku", "Column1", Splitter.SplitTextByWhitespace(QuoteStyle.Csv)),
#"Záhlaví se zvýšenou úrovní" = Table.PromoteHeaders(#"Rozdělit sloupec oddělovačem", [PromoteAllScalars=true]),
#"Změněný typ s národním prostředím" = Table.TransformColumnTypes(#"Záhlaví se zvýšenou úrovní", {{"T_Set", type number}, {"T_Rec", type number}, {"HR_Rec", type number}, {"HR_Set", type number}}, "en-US"),
#"Změněný typ" = Table.TransformColumnTypes(#"Změněný typ s národním prostředím",{{"Date", type date}, {"Hour", type time}}),
tab = Table.Buffer(Table.ReplaceValue(#"Změněný typ", each [Date], each [Date] & [Hour],Replacer.ReplaceValue,{"Date"})),
//
// Počítání statistiky (do recordu, pak se to spojí do tabulky)
posledniRadek = Table.Last(tab),
Stat = [
Začátek předehřevu = tab[Date]{0},
// Konec předehřevu = List.Max(tab[Date]),
Konec předehřevu = posledniRadek[Date],
Teplota nastavená = tab[T_Set]{0},
Teplota MIN = List.Min(tab[T_Rec]),
Teplota MAX = List.Max(tab[T_Rec]),
Vlhkost nastavená = tab[HR_Set]{0},
Vlhkost MIN = List.Min(tab[HR_Rec]),
Vlhkost MAX = List.Max(tab[HR_Rec]),
// Teplota in spec start = List.Min(Table.SelectRows(tab[[Date], [T_Rec]], each [T_Rec] >= #"Teplota nastavená" - 5)[Date]),
lim = #"Teplota nastavená" - 5,
Teplota in spec start = List.Min(Table.SelectRows(tab, each [T_Rec] >= lim)[Date]),
Total time = #"Konec předehřevu" - #"Začátek předehřevu",
Time in Spec = #"Konec předehřevu" - #"Teplota in spec start",
Náběh teploty = #"Teplota in spec start" - #"Začátek předehřevu",
Poslední teplota = posledniRadek[T_Rec],
Poslední vlhkost = posledniRadek[HR_Rec],
Počet záznamů v TXT = Table.RowCount(tab), // Co má být velikost??? záznamy, pokud byte, tak je to v info o souboru
Poslední datum = DateTime.Date(#"Konec předehřevu")
]
in
Stat
Všechny soubory se pak vyhodnotí normálně:
let
Zdroj = Folder.Files(Excel.CurrentWorkbook(){[Name="tblCesta"]}[Content]{0}[Cesta]),
#"Filtrované řádky" = Table.SelectRows(Zdroj, each [Extension] = ".TXT" and not Text.Contains([Name], "Default") and [Attributes][Hidden] <> true),
#"Rozdělit sloupec oddělovačem" = Table.SplitColumn(#"Filtrované řádky", "Name", each List.Select(Splitter.SplitTextByAnyDelimiter({" ","-", "_", "."}, QuoteStyle.Csv, false)(_), (l) => l <> ""), {"pref.1", "pref.2","Předehřev", "Name.2", "Nastavený čas", "Batch"}),
#"Odebrané sloupce" = Table.SelectColumns(#"Rozdělit sloupec oddělovačem",{"Content", "Batch", "Předehřev", "Nastavený čas", "Date modified"}),
#"Přejmenované sloupce" = Table.RenameColumns(#"Odebrané sloupce",{{"Date modified", "Datum modifikace"}}),
//
// Přidaná statistika suoboru
#"Statistika souboru" = Table.TransformColumns(#"Přejmenované sloupce",{{"Content", Statistika}}),
#"Rozbalené Content" = Table.ExpandRecordColumn(#"Statistika souboru", "Content", {"Začátek předehřevu", "Konec předehřevu", "Teplota nastavená", "Teplota MIN", "Teplota MAX", "Vlhkost nastavená", "Vlhkost MIN", "Vlhkost MAX", "Teplota in spec start", "Total time", "Time in Spec", "Náběh teploty", "Poslední teplota", "Poslední vlhkost", "Počet záznamů v TXT", "Poslední datum"}),
#"Odebrané ostatní sloupce" = Table.SelectColumns(#"Rozbalené Content",{"Batch", "Předehřev", "Nastavený čas", "Datum modifikace", "Začátek předehřevu", "Konec předehřevu", "Teplota nastavená", "Teplota MIN", "Teplota MAX", "Vlhkost nastavená", "Vlhkost MIN", "Vlhkost MAX", "Teplota in spec start", "Total time", "Time in Spec", "Náběh teploty", "Poslední teplota", "Poslední vlhkost", "Počet záznamů v TXT", "Poslední datum"}),
// tohle je navíc, v excelu je to triviální vzorec
#"Přidaný sloupec" = Table.AddColumn(#"Odebrané ostatní sloupce", "Pravda/Nepravda", each DateTime.Date([Datum modifikace]) = [Poslední datum], type logical),
#"Změněný typ" = Table.TransformColumnTypes(#"Přidaný sloupec",{{"Začátek předehřevu", type datetime}, {"Konec předehřevu", type datetime}, {"Teplota nastavená", type number}, {"Teplota MIN", type number}, {"Teplota MAX", type number}, {"Vlhkost nastavená", type number}, {"Vlhkost MAX", type number}, {"Vlhkost MIN", type number}})
in
#"Změněný typ"
ctrl-F, zadat frázi, najít vše, ctrl-A, del
Co třeba použít Word (hromadný tisk)?
To je hláška ochránce osobních údajů. Ve dvou dotazech se dotazujete na dva zdroje a to mu vadí. (Srozumitelnost je mizerná i v anglické verzi, ale jak to zkomolil lokalizační tým...) Má to bránit proti úniku tajných údajů - ve druhém dotazu je adresa a jméno souboru, spíš to slouží k nas... uživatelů.
Máte dvě možnosti. Sloučit dotazy do jednoho, např.:
let
Soubor = Excel.CurrentWorkbook(){[Name="Cesta"]}[Content]{0}[Column1],
Zdroj = Csv.Document(File.Contents(Soubor),[Delimiter=";", Columns=7, Encoding=1250, QuoteStyle=QuoteStyle.None]),
#"Záhlaví se zvýšenou úrovní" = Table.PromoteHeaders(Zdroj, [PromoteAllScalars=true]),
Řádky = Table.AlternateRows(#"Záhlaví se zvýšenou úrovní", 1,1,1),
#"Změněný typ" = Table.TransformColumnTypes(Řádky,{{"Den", type text}, {"Datum", type date}, {"Cas", type time}, {"OUT_Teplota", type number}, {"IN_Teplota", type number}, {"IN_Vlhkost", type number}, {"Bat", type number}}, "en-GB")
in
#"Změněný typ"
Podstatné jsou jen první dva řádky. Dál jsem jen zjednodušil logiku a převedl čísla na čísla.
Asi lepší je ochranu zakázat. Hlavní menu ve 2016 si nepamatuju, ale vypnout se to dá z prostředí PQ editoru: Soubor > Možnosti a nastavení > možnosti dotazu >
Pak v sekci globální : Ochrana osobních údajů > vždycky ignorovat.
Jen pro soubor se dá totéž nastavit v sekci lokální.
Pravý klik na tabulku a obnovit nestačí ??
Nebo v menu vybrat Aktualizovat ?
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.