Příspěvky uživatele
< návrat zpět
PS: Ešte poznámka, ak sa nemajú prepisovať existujúce XLSX, tak výstup nastavte do inej zložky ako doteraz. Lebo urobil som obe metódy tak, aby sa nepýtali a rovno prepísali.
Otázka je, či to potrebujete mať ako samostatné súbory alebo zlúčené spolu, keď robíte potom z toho nejaké KT.
Ak je počet tých súborov naozaj väčší, napr. desiatky či stovky, tak by som použil metódu 2 alebo 3. Obe zbytočne nevytvárajú súbor xlsx pre každý CSV, ale upravia ten predošlý a uložia. Šetrí sa tým čas. A poradia si nielen s "*.csv" ale aj s "*.CSV". Zobrazuje sa v nich priebeh dole v StatusBare. Tá metóda 3, vytvorí druhú inštanciu Excelu, aby nedochádzalo k tomu blikaniu. Testoval som to na 32 súboroch CSV, rôznych veľkostí (700 B - 5,1 MB), a rozdiel v čase je značný.
No ak to má byť spolu, tam potom cez PowerQuery.
Je to iba návrh.
CSV nieje zošit. Nemá žiaden list, a teda ani názov listu. Myslíte to asi tak, aby sa list Excelu, ktorý je vytvorený z CSV, volal tak ako sa volal súbor CSV (bez ".csv" na konci). V tom prípade skúste v procedúre C2X medzi tieto 2 riadky
With ActiveWorkbook
On Error Resume Next
vložiť toto
.ActiveSheet.Name = Left$(Replace(JmenoA, ".csv", ""), 32)
Tipnem si, že stačí v procedúre ImportDat na konci pripísať riadok
ActiveSheet.Name = "Data"
Skôr si myslím, že niečo takéto:
=VLOOKUP(C41&"";INDIRECT("'"&C39&"'!C6:BC32");MATCH(C43;INDIRECT("'"&C39&"'!D5:BC5");0)+1;FALSE)
=SVYHLEDAT(C41&"";NEPŘÍMÝ.ODKAZ("'"&C39&"'!C6:BC32");POZVYHLEDAT(C43;NEPŘÍMÝ.ODKAZ("'"&C39&"'!D5:BC5");0)+1;NEPRAVDA)
Uvidím, či prídete na malú drobnosť :)
.HTMLbody = "<HTML><BODY>A part was removed from the cabinet - /<A href='file://" & Link & "'>Link</A>/</BODY></HTML>"
Alebo bez maticového zápisu
=SUMPRODUCT(--(B3:B13<B2:B12))
=SOUČIN.SKALÁRNÍ(--(B3:B13<B2:B12))
Vzorcom to fungovať nebude. Vzorec sa aktualizuje pri každom prepočítaní listu, teda by tam bol vždy aktuálny dátum, nie ten čo bol pri naskenovaní. Vzorec dokáže uchovať vlastnú hodnotu iba ak je zapnutý Iteračný výpočet v Nastaveniach Excelu. Problém ale je pri prenose takého súboru inde ako na takto nastavený Excel. Riešenie vidím v makre. Príklad, ktorý zvládne aj hromadné zmeny v A (Vám by stačilo na 1 bunku), pričom pri prázdnej A maže D, pri nejakej hodnote v A zapíše čas do D, všetko v daných riadkoch.
Inak vzorec pre Iteračný výpočet by mohol byť zhruba
=IF(A2<>"";IF(D2<>"";D2;NOW());"")
=KDYŽ(A2<>"";KDYŽ(D2<>"";D2;NYNÍ());"")
EDIT: Neskoro. Kým som to dopísal, už to tu máte :)
Na fóre MS odpísali, že to v Exceli nejde, a treba sa pokúsiť to vyriešiť cez API, alebo ručne.
Na stackoverflow je takýto kód, treba poskúšať. Ja duplex nemám.
Každopádne treba pohľadať deklarácie použitých API pre jednotlivé kombinácie Win64/32, Office64/32, VBA6/7, teda PtrSafe, LongPtr, LongLong, a správne podmienene deklarovať cez "#If", a to sa chce málo komu, lebo na LongPtr a LongLong vs Long nieje univerzálne pravidlo pre každú API :(.
Aspoň mne sa teda nepodarilo úspešne sprevádzkovať (bez nepredvídateľného padania) všetky API pomocou pravidiel.
EDIT: Prípadne možno by šlo urobiť makro na posielanie strán na tlač po jednej, podľa PageBreak.
Tak to sa rozpíšte podstatne viac, presnejšie, a ukážte manuálne vytvorený príklad očakávaného výsledku.
Vidím, že podmienkou na zoradenie nieje iba najvyšší súčet "bak" hodnôt, ale ešte sú tam nejaké iné podmienky.
Ale už naposledy.
Tak skúste toho, či som to trafil, lebo mám v tých fotrovcoch a ratolestiach už fakt bordel 
Skúste ešte toto, vzorec nedáva TRUE/FALSE (PRAVDA/NEPRAVDA), ale 0/1. Napadlo ma, či náhodou nieje pes zakopaný v CZ Exceli. Prípadne úplne od boku skúste v predposlednom riadku na konci zmeniť
Criteria1:=1
na niečo z tohto
Criteria1:="1"
Criteria1:="=1"
V predošlej verzii, kde je TRUE/FALSE tam skúste
Criteria1:="True"
Criteria1:="=True"
Criteria1:="=" & True
alebo úplnú sprostosť
Criteria1:="Pravda"
Criteria1:="=Pravda"
Dal som to aj do Office2007 na Win7x64 - bez problémov. Dokonca po úprave vzorca som to zfunkčnil aj na XP + Office2003 (bez TextBoxu a musel som upraviť vzorec, lebo Office 2003 nepozná IFERROR ani ActiveX TextBox [nie som si istý], ale makro presunuté do modulu bez zmeny funkčné).
Skutočne netuším ako pomôcť.
EDIT:
Pozrite ešte po "vykonaní" filtru napr. hodnoty 73063080, aké sú možnosti hodnôt vo filtry, keď kliknete na ikonku filtra v A2, a ktorá je zaškrtnutá.
Ak nepočítame Application.ScreenUpdating, tak má makro len 5 riadkov kódu, tak ho odkrokujte.
1. Najskôr odkryte stĺpec A
2. Skontrolujte, či máte povolené automatické počítanie vzorcov.
3. Manuálne úplne zrušte filter A2:H2
4. Zadajte prázdny TextBox
5. Manuálne cez F8 prejdite za riadok
Riadkov = Cells(1, 1).CurrentRegion.Rows.Count
a kurzor myši presuňte nad premennú Riadkov. Napíšte sem hodnotu.
6. Cez F8, prejdite za ďalší riadok, a napíšte hodnotu RiadkovA.
7. Napíšte či prejde kód za Then v riadku s podmienkou
If RiadkovA < Riadkov Then
8. Po prejdení na
If TextBox1.Text = "" Then
skontrolujte či sú vzorce v A od prvého až po posledný záznam. Ak je TextBox prázdny, všetky výsledky v A3:A6287 musia byť TRUE/PRAVDA.
9. Kód nechajte dobehnúť a napíšte ako to dopadlo.
10. Urobte si BrakePoint na prvom riadku kódu
11. Zadajte do TextBoxu číslo 73063080 (naraz kopírovaním, nie písaním). Zopakujte kontroly a rovnako dajte vedieť výsledky krokov 5.-9.
Pozorne čítajte každý krok a každé slovo, a presne napíšte výsledky, ktoré som dotazoval. Inak fakt neviem, môj typ je zakázané prepočítanie vzorcov.
PS: inak v predposlednom riadku treba zmeniť číslo 7 na 8, ale to nemá podstatný vplyv na svoju funkciu rušenia filtra.
Ale ActiveX nepôjdu:
Sub ObjektyVoVybere()
Dim SH As Shape, R As Long, B As Long, L As Long, T As Long, Co As Integer, Ro As Long, SHL As Long, SHT As Long, SEL As String
If TypeName(Selection) <> "Range" Then Exit Sub
With Selection
Co = .Columns.Count: Ro = .Rows.Count
L = .Left: T = .Top: B = .Offset(Ro, 0).Top - 1: R = .Offset(0, Co).Left - 1
End With
With ThisWorkbook.ActiveSheet
For Each SH In .Shapes
With SH
SHL = .Left: SHT = .Top
If SHL >= L And SHL + .Width - 1 <= R And SHT >= T And SHT + .Height - 1 <= B Then SEL = SEL & IIf(SEL = "", "", vbCr) & .Name
End With
Next SH
End With
If SEL <> "" Then ActiveSheet.Shapes.Range(Split(SEL, vbCr)).Select
Set SH = Nothing
End Sub
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