Sub SpustiZmenu_Click()
Dim Cesta As String, Subor As String, WB As Workbook, x As Long
Cesta = ThisWorkbook.Path & IIf(Right(ThisWorkbook.Path, 1) = "\", "", "\")
Subor = Dir(Cesta & "*.xlsx", vbNormal)
Application.ScreenUpdating = False
While Subor <> vbNullString
On Error GoTo CHYBA
Set WB = Workbooks.Open(Cesta & Subor)
On Error GoTo 0
With WB
With .ActiveSheet
For x = 1 To .Cells(Rows.Count, 2).End(xlUp).Row
.Cells(x + 1, 1) = .Cells(x + 1, 3).Value & .Cells(x + 1, 4).Value
Next x
End With
.Save
.Close
End With
GoTo POKRACUJ
CHYBA:
MsgBox ("Chyba pri spracovaní súboru :" & vbNewLine & vbNewLine & Cesta & Subor)
POKRACUJ:
Subor = Dir()
Wend
Application.ScreenUpdating = True
End Sub
Vytvorte si v zložke s Vašimi súbormi jeden súbor XLSM v ktorom napr. tlačítkom spustite makro.
PS: Ešte som zabudol dodať, že to otvorí a Vašim spôsobom upraví všetky súbory "*.xlsm", ktoré v danom adresári nájde. Takže pokusy robte na kópii adresára s ostrými dátami.
Chýba Vám nadpis v skrytom stĺpci A. Je potrebný aj kvôli Rozšírenému filtru, aj kvôli zisťovaniu posledného riadku.
Ak chcete, pošlite mi na mail reálne súbory, pozriem sa Vám na to a sprevádzkujem. Ale priložte mi tam aj ručne urobený vzhľad ako to má vyzerať. Stačí s kúska údajov. Ak teda chcete. Zneužitie Vašich dát je vylúčené.
Tu máte 2 verzie. Jedna pre celkový súčet, druhá pre súčty jednotlivých listov.Jednoduché to zrovna nieje. Neznámy počet listov o neznámych názvoch, s neznámym počtom položiek, s neznámymi unikátmi, spojiť z nich všetky hodnoty do jedného poľa čo najrýchlejšie bez cyklov, vyzrieť na Rozšírený filter (ten obsahuje zákernosť, ktorá sa rieši krkolomne) ...
Nechcelo sa mi už ďalej s tým paprať a vymýšľať ako vypísať iba pre každý list iba jeho jedinečné položky, tak som si pomohol z príkladu spoločného súčtu, a v tabuľke všetkých jedinečných z všetkých listov, je proste 0 pri liste kde sa táto hodnota nenachádza. Neviem, či to takto môže byť.
Snáď aspoň niečo pomôže.
V jednom liste máte data do zoznamov, ďalej sú tam pomenované oblasti kategórií, a tie sa cez INDIRECT načítavajú do Overenia údajov.
Nevýhoda je ale tá, že keď zmeníte prvý stĺpec, tak sa neaktualizuje aj druhý, ale musíte si vybrať z už korektných hodnôt podľa prvého. Vyskúšajte a pochopíte.
=IF(ISERROR(C1);"-";C1)
C1 je bunka s hodnotou/chybou. A nemohlo by to byť rovno v tej bunke ? Ak áno, tak to "C1" vo vzorci zamente za to čo je v tej konkrétnej bunke, ten vzorec čo tam v nej je.
teda napr. :
=IF(ISERROR(A1/B1);"-";A1/B1)
kde "A1/B1" je ten vzorec, čo Vám vytvára tú hodnotu/chybu
Maticový vzorec, C1 je tá hranica, A1:A29 je Váš rozsah hodnôt-
=IFERROR(INDEX($A$1:$A$29;SMALL(IF($A$1:$A$29>$C$1;ROW($A$1:$A$29));1));"")
Ak máte rozsah od iného riadku ako 1, tak potom treba upraviť vo vzorci referenčné hodnoty číslovania indexu. To -3 znamená, že sú pred Vašim rozsahom 3 riadky :
=IFERROR(INDEX($A$4:$A$32;SMALL(IF($A$4:$A$32>$C$1;ROW($A$4:$A$32)-3);1));"")
A ak hľadáte nie prvú hodnotu v stĺpci, ktorá presahuje hranicu, ale ak hľadáte prvú najnižšiu hodnotu presahujúcu hranicu :
=IFERROR(MIN(IF($A$4:$A$32>$C$1;$A$4:$A$32));"")
@habi : Veď som to napísal nad Vami, ale opakovanie je matka múdrosti. :)
No ak máte tie farby hodnôt vlastnoručne zafarbené (teda nie Formátom bunky, napr. kladné/záporné čísla), tak:
-Označte rozsah / alebo celý stĺpec
-Ctrl+F
-Formát - tá malá šípka - Vybrať formát bunky - klik na zafarbenú hodnotu
-Nájsť všetky
-klik do poľa s nájdenými a Ctrl+A
-Zavrieť
-A máte ich označené
Alebo
-na karte Data vytvorte Filter pre oblasť alebo stĺpec
-Filtrovať podľa farby - napr. červená
-vykonajte požadované úpravy, a filter zrušte, kliknutím na ikonu Filter
Ale ak to máte farbené pomocou Formátovania bunky/Podmieneného formátovania, tak asi jedine makrom (priradte napr. tlačítku):
Sub SelectColor()
Dim R As Range, C As Long, B As Range, A As Range
On Error GoTo koniec
Set R = Application.InputBox("Oblasť v ktorej chcete hľadať farbu :", "Označenie buniek podľa farby", Selection.Address, , , , , Type:=8)
C = Application.InputBox("Označte bunku s farbou, ktorá sa má hľadať :", "Označenie buniek podľa farby", Selection.Cells(1, 1).Address, , , , , Type:=8).DisplayFormat.Font.ColorIndex
On Error GoTo 0
For Each B In R
If B.DisplayFormat.Font.ColorIndex = C Then If A Is Nothing Then Set A = B Else Set A = Union(A, B)
Next B
A.Select
koniec:
End Sub
Máte asi pravdu, INDIRECT nejde takto použiť. Napadlo ma ExecuteExcel4Macro, ale to sa mi rovnako nedarí sprevádzkovať vo funkcii ale iba v procedúre. Vy ale potrebujete funkciu volanú zo zošitu, čiže posledná možnosť čo ma napadá je ADODB použité v UDF:
Function GetCell(F As String, H As String, C As Range) As String
Dim cnStr As String, rs As ADODB.Recordset, query As String
cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & F & ";Extended Properties=Excel 12.0"
query = "SELECT * FROM [" & H & "$" & C.Address(0, 0) & ":" & C.Address(0, 0) & "]"
Set rs = New ADODB.Recordset
rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified
GetCell = rs.Fields(0).Name
rs.Close
End Function
Najskôr pridajte vo VBA v Tools - References - Microsoft ActiveX Data Objects 6.1.
Potom funkciu v zošite budete volať:
=GetCell("z:\Close\ZAKAZKOVE_LISTY.xlsx";$A$12;$N$6)
PS: A ešte ma napadlo použiť skrytý stĺpec/list, a vo funkcii vložiť vzorec s priamym odkazom a prečítať hodnotu, ale to sa mi rovnako vo funkcii nepodarilo, len v procedúre, viď vyššie...
Skontrolujte si nastavenie DPI dokumentu aj defaultné DPI tlačiarne. Musí tam byť natívne rozlíšenie tlačiarne na ktorej sa to tlačí. Najčastejšie 300 alebo 600. To ma napadá ako prvé.
- Iný uživatelia tlačia na tej istej tlačiarni (napr. v sieti) ?
- Z iného programu ak tlačíte na tej istej tlačiarni, tak to vytlačí OK (napr. Word) ?
??? Toto je tabuľka klientov ? Klient AAAA, klient BBBB, klient SS, klient POO, klient TU.
A Vy teraz chcete čo ? Ja naozaj nerozumiem. Vy musíte napísať príklad toho čo chcete urobiť, a čo očakávate.
Takže Vy napr. zmeníte druhú bunku s klientom BBBB (7. riadok) na CCC, a chcete aby sa pod tento zmenený 7. riadok vložil nový riadok ?
Čiže výsledok bude:
AAAA
AAAA
AAAA
AAAA
AAAA
BBBB
CCC
-----prázdny riadok---
BBBB
SS
POO
POO
TU
TU
TU
TU
TU
TU
TU
Skúste to popísať úplne inak, o rád podrobnejšie, ale hlavne sa pokúste vcítiť do človeka, ktorý nemá o Vašej problematike páru, a netuší čo tým myslíte,a nevie čo Vy považujete za samozrejmé.
Ďalej chcete vkladať pod názov klienta počet, ja tam ale žiadny počet nevidím, iba názvy klientov, nie počty. Ten počet pôjde do iného stĺpca ?
atď, atď...
Po preinštalovaní PC, často písmená diskov niesú tak ako predtým. Bude to asi v tej ceste, lebo to Vaše makro mi funguje aj na Office 2010 x86 aj na 2013 x64.
Celé Vám to zvládne aj jeden riadok:
Sub UlozPLdoPDF() ' UlozPLdoPDF Makro
Sheets("Pracovní list").ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\SkyDrive\Horňas\Pracovní listy\" & Trim((Worksheets("DATA").Range("O15").Value)), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Sheets("Fakturace").Activate
End Sub
Ak sa prepínate z listu do listu len preto aby ste mohli exportovať aktívny list, tak to nemusíte. A ak voláte export z listu Fakturace, aj aktiváciu tohto listu zmažte.
PS: Do jedného riadku si dávam iba príkazy, ktoré mám overené že určite fungujú na 100%, a nepredpokladá sa ich prerábanie, v opačnom prípade sa zle čítajú.
Vytvorte si novú tabuľku, rovnakú ako pre SUMPRODUCT, a vymente vzorce napr. za niečo takéto:
PS: Pozor na zaokrúhľovanie, hodnotu z E18 (0,22) číta ako 0,218. Vypočítaná je 0,218, ale v hornej tabuľke je zaokrúhlená na 0,22.
No zapracoval som na Vašom probléme, a je s toho nasledovné.
-Je použitý skrytý list "Temp", v ktorom sa vytvárajú makrom vzorce, ktoré vyťahujú data zo súborov.
-Všetko prebieha hromadne, s čo najmenším počtom prestupov medzi VBA a Makrom (to je totiž pomalé)
-Je to nastavené na Váš adresár.
-Testované je to na 211 súboroch a 71 riadkoch dát, a rýchlosť vytiahnutia dát zo všetkých súborov, porovnania, vyfiltrovania prázdnych hodnôt, vytvorenie HyperTextových odkazov, všetko dokopy trvá na mojom PC 2,1 sekundy.
-Ošetrené je aj to, že ak je súborov so zhodou viac ako 6 (počet vyhradených riadkov), tak sa zobrazí len prvých 6.
-Ak by v F2 nebola hodnota, musí sa zobraziť "-" (kvôli nasledujúcim procedúram to nemôže ostať na "")
-Pozor si dávajte pri vytváraní nových riadkov, nezabúdajte, že musia byť zlúčené bunky (6 riadkov), a to v prvom rade v stĺpci A, pretože ten je smerodajný pre počet "výpočtov".
-Snáď ste myslel tie odkazy takto, ako som to spravil.
-Opravil som Vám formátovanie stĺpca E, ktoré bolo nastavené tak, že sa hodnoty nezobrazovali, aj keď v bunke boli (nie "Centrovať na stred výberu", je potrebné iba "Centrovať").
A čo sa týka toho kde prečo Vám nefunguje to čo ste poslal naposledy, tak hneď vo vkladanom vzorci máte na konci mať odkaz na "BOM" a nie na "Figur". ďalej som neskúmal, pretože ako som vravel, je to bezpredmetné.
Vyskúšajte túto novú verziu, a dajte vedieť. Len to nechcite vysvetľovať, lebo pri tom ma už asi naozaj klepne 
Presne tak, dajte sem prílohu 2 súborov na aktualizovanie a 1 súbor z ktorého sa ťahajú data. Svoje data si zmažte a nechajte len 1-2 riadky vymyslených dát.
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.