Příspěvky uživatele

Posilam tedy reseni makrem - dukladne okomentovane v kodu. Ber to jako prvni lekci. Pokud totiz aspirujes na pochopeni pomoci vzorce, tak logiku makra urcite pochopis taky.
Doufam, ze do kodu se umis dostat, kdyby ne, tak Alt+F11

Existuji vzoreckovi magove kteri toto umi, to pokazde valim kukadla.
Ja bych to resil makrem, ktere by v tomto pripade bylo natolik jednoduche, ze by ho pochopil i uplny laik. Ale zadani zni vzoreckem

Neni divu, ze nic uspokojiveho nenajdes. Je to totiz tak rozsahla a spletita problematika, ze ani profesionalni dochazkovy software neumi zrovna to, co by bylo potreba. Ve trech ruznych zamestnanich jsem pouzival nejaky excelovy udelator, ktery jsem neustale dovyvijel na zaklade specifickych pozadavku daneho provozu a kazdy byl uplne jiny. V tom tretim provozu jsem si zpocatku myslel, ze pouziju hotove osvedcene reseni z tech predchozich, ale nakonec se to nedalo pouzit a muselo se to tvorit znovu a jinak. Byly na to zkratka jine pozadavky a spousta perfektnich funkcionalit se promenila v balast.
Takze rada nakonec: udelej si pokud mozno co nejpresnejsi predstavu, jak to ma byt a pust se do toho. Vyhni se sloucenym bunkam! A az budes v koncich, tak se vzorovym sesitem zde zaloz prispevek, kde naprosto jasne formulujes konkretni problem.

No, zdá se, že to je spíše něco jako trailer k nějakému filmu

. Ale i tak by to mohlo být prospěšné...

Možná už to tady bylo, ale pokud ne, tak zde je link na Knihu Jaroslava Černého o programování maker. Kniha je online tedy dá se v ní listovat i vyhledávat. Nedá se z ní kopírovat, což je pochopitelné. Bohužel, mnoho stránek je tam vynechaných

, ale i tak je to úžasná věc.
Doporučuji všem, kteří mají zájem se něco přiučit. Ne že bych si od toho sliboval pokles líných excelových somráků

, ale jako studnice VBA vědomostí se to dá použít
http://books.google.cz/books?id=JTg7HvmxEKYC&printsec=frontcover&hl=cs#v=onepage&q&f=false

Tak to by mohl byt problem s relativnim adresovanim.
Zkus toto: vlez do radku vzorce ktery je OK, mysi si oznac nektery argument funkce a zmackni F9. To ve vzorci nahradi dany argument primo jeho hodnotou. Pak udelej totez ve spatnem vzorci a mel bys poznat ktery argument vraci blbost.
Pozor, kdyz opoustis radek vzorcu, udelej to "iskejpem". Pokud to udelas entrem, ta zmena agrumentu za jeho hodnotu zustane natvrdo

V anglickem excelu:
=MID(A2,FIND("/",A2)-3,3)

Nevim ceske ekvivalenty, asi CAST, NAJDI, a misto carek stredniky. Hledej v textovych funkcich, je to nektera z nich

Rado se stalo

Takhle je to v anglickem excelu:
=VLOOKUP(D2,{"Křepáčková","Skupina č. 1";"Jirmus","Skupina č. 1";"Pyšná","Skupina č. 1";"Kaderka","Skupina č. 1";"Fiala","Skupina č. 1";"Němec","Skupina č. 1";"Fidera","Skupina č. 1";"Kozderka","Skupina č. 2";"Holý","Skupina č. 2";"Líný","Skupina č. 2";"Urtová","Skupina č. 2";"Malíčková","Skupina č. 2";"Novák","Skupina č. 2"},2,0)
V ceskem to bude SVYHLEDAT misto Vlookup a stredniky misto carek

Aha, tak konecne jasne vyjadreni. Nikde nezaznelo, ze nejaky existujici filtr bude ve stejnem sloupci.
Tak to plneni kolekce pujde jeste pres podminku.
Zde je ten upraveny fragment:

For i = iStartRow To iStartRow + iRows - 2
If Rows(i).Hidden = False Then
cKol.Add Item:=CStr(Cells(i, "L").Value), Key:=CStr(Cells(i, "L").Value) 'budeme to tam davat jako string, proto CStr
End If
Next i

S tim rozpoznanim filtru to je zvlastni, ale zkousel jsem to a mas pravdu, skutecne se to na prilozenem souboru takhle stupidne chova. Nevim cim to je, pridavam to do seznamu vrtochu excelu. Doted jsem se s tim jeste nesetkal. Nevadi, tato cast se da preskocit (radeji zaremovat nez smazat).
Dalsi casti tve otazky nerozumim cos tim chtel rict. Zejmena vyraz "vyfiltruje" nemusi mit jednoznacny vyznam. Jestli se nepletu, tak takhle znelo zadani: nasadit takovy filtr, aby byly skyte radky, ve kterych jsou ony tri vyjmenovane hodnoty a vsechny ostatni radky budou videt. A takhle mi to funguje. I kdyz znova ctu uvodni prispevek, porad si to chapu stejne. Anebo fakt uz prestavam rozumet cestine

. Chtel jsi to snad obracene?

Neskodilo by, kdyby ses vyjadril presne. Ten muj kod nemuze hlasit kolik listu je nacteno. Pokud to neco hlasi, tak to je pocet zkopirovanych listu a v tom stadiu by opravdu mely byt zkopirovane.
Nezbyva nez abys provedl zakladni troubleshooting. Zaremuj (na zacatek radku vloz apostrof) prikaz Application.ScreenUpdating = True.
Nasad zarazku (F9) na kopirovaci radek Range(Cells(1, 1), Cells(iLastR, iLastC)).Copy (ws.Cells(iMxRow, 1)) a spust makro (F5). Procedura se zastavi na zarazce, radek zustane zluty.
Zkontroluju hodnoty vsech promennych, jestli zodpovidaji skutenosti. Dal uz krokuj F8. Hned po prvnim kroku se musi prvni list vybraneho souboru nakopirovat. Jestli ne, napis mi hodnoty vesch promennych - uvidis je v Locals Window, ktere zobrazis pres VBA menu View(Zobrazit) - Locals Windows). Snaz se premyslet, co by mohlo byt spatne. Jestli ten kopirovany list (v tomto okamziku bude zrovna aktivni) opravdu nejaka data obsahuje, na kterem radku ta obast dat konci, jestli tomu odpovida hodnota promenne iLastR atd... Chces-li makra pouzivat, musis taky vynalozit usili. Jinak budes odsouzen na excelovou zebrotu. A jeste neco: az zjistis kde byl problem, tak nam to taky rekni, ne jak vetsina tazatelu, kteri bud nenapisou nic, anebo jen...tak uz to funguje

@kp57:
Parada, toto opravdu vraci skutecnou posledni bunku. Jeste kdyby to umelo resetovat tu puvodni nesmyslne obrovskou oblast, kterou vraci .UsedRange anebo .Cells.SpecialCells(xlCellTypeLastCell).

@marjankaj: jak uz jsem naznacil, nestava se to bezne, ale obcas k tomu dochazi, totiz ze posledni bunka je uplne jinde (niz) nez by mela byt. Proto radeji pouzivam delsi, ale o to odolnejsi kod, tedy skok odspodu v nejakem sloupci

Dik za tip s LastCell, prestal jsem ho kdysi uplne pouzivat, nebot se to nechovalo regulerne, pamatovalo si to posledni bunku treba na radku 1000 a i kdyz se tam pak vymazaly radky, porad to vracelo ten puvodni nesmysl a neslo to spolehlive resetovat ani rucne ani kodem. Ale pro ucely kopirovani nezname oblasti to je idealni.

K samotnemu kodu: nezabyval jsem se odolnosti vuci stavum, kdy kopirovany sesit anebo list je zamceny, schovany nebo obsahuje dalsi zrady.
Sub Kopiruj()

Dim wb As Workbook, wbX As Workbook
Dim ws As Worksheet, wsx As Worksheet
Dim i As Integer, j As Integer, iMxRow As Long, iLastR As Long, iLastC As Long, k As Integer

'zkratka pro tento sesit
Set wb = ThisWorkbook
Set ws = ActiveSheet

' Otevri dialog
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ""
.AllowMultiSelect = True
.Filters.Add "Excel", "*.xls"
.Show

Application.DisplayAlerts = False
Application.ScreenUpdating = False

' pro kazdy vybrany soubor
On Error GoTo errHandler
For i = 1 To .SelectedItems.Count

Workbooks.Open .SelectedItems(i)
Set wbX = ActiveWorkbook
'nakopiruj listy do wb
For j = 1 To wbX.Sheets.Count
Set wsx = wbX.Worksheets(j)
'posledni radek a sloupec oblasti ke kopirovani
iLastR = wsx.Cells.SpecialCells(xlCellTypeLastCell).Row
iLastC = wsx.Cells.SpecialCells(xlCellTypeLastCell).Column

'novy radek na cilovem liste: zkoumej A,B C sloupce
iMxRow = Application.Max(ws.Range("A65000").End(xlUp).Row, ws.Range("B65000").End(xlUp).Row, ws.Range("C65000").End(xlUp).Row)
If iMxRow > 1 Then iMxRow = iMxRow + 2 'at je mezi daty jeden prazdny radek
k = k + 1

wsx.Activate

' 'pokud kopirovat uplne vse tak takhle:
Range(Cells(1, 1), Cells(iLastR, iLastC)).Copy (ws.Cells(iMxRow, 1))
' ws.Cells(iMxRow - 1, 1) = "Ze souboru: " & wbX.Name & " List: " & wsx.Name & " " & k
' 'pokud kopirovat jenom hodnoty a treba formaty tak tahkle:
' Range(Cells(1, 1), Cells(iLastR, iLastC)).Copy
' ws.Activate
' Cells(iMxRow, 1).PasteSpecial Paste:=xlPasteValues
' Cells(iMxRow, 1).PasteSpecial Paste:=xlPasteFormats
Next j
wbX.Close (0)
Next i

End With

MsgBox "Zkopirovany oblasti z " & k & " listu"
GoTo fiNito

errHandler:
MsgBox "Zkopirovano pouze " & k & " listu" & vbCr & _
"Pri kopirovani listu " & wsx.Name & "ze souboru " & wbX & " doslo k chybe"

fiNito:
With Application
.CutCopyMode = xlCut
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje