< návrat zpět

MS Excel


Téma: Propojení sešitů rss

Zaslal/a 3.6.2013 3:33

Prosím o radu ohledně propojení sešitů v jedné složce.
V dané složce budu mít určitý počet sešitů, které budou totožné, jen vyplněné různými daty. V každém tomhle sešitu budou tři políčka s čísly. Dále bude ve složce soubor, v kterém budu chtít evidovat ta tři políčka ze všech ostatních sešitů. Sešity mimo tohoto mají název ve tvaru 123_yymmdd_text (123 a datum se bude lisit, text je stejny u vsech) - jak muzu nejakym efektivnim zpusobem nacitat do prehledoveho souboru data ze vsech ostatnich souboru? Napadlo me - cislo 123 bych napsal do radky, vedle by se automaticky generoval zbytek nazvu souboru a rovnou by byl pouzit v odkazu na dany soubor. Jde ale nejak vynechat cast datumu? bude se casto menit a nerad bych ho porad aktualizoval v hlavnim souboru.
Doufam ze je to aspon trochu pochopitelne.
Jeste obecna otazka: jde nejak aby halvni soubor cerpal data automaticky ze vsech souboru v urcite slozce?

Zaslat odpověď >

#013620
avatar
tak som urobil nejake jednoduche makro

funguje takto:
- spusta sa cez "test"
- nacita vsetky subory ktore sa nachadzaju v adresari "XLS"
- naplna pole d() a po procese zapise do aktualneho zositu
- makro je popisane ... takze sa da aj prerobit podla svojich predstav
- je tam aj viditelny progressbar

dajte potom vediet ci vyhovuje :))
Příloha: zip13620_test.zip (27kB, staženo 33x)
citovat
#013646
avatar
Moc díky! Na první pohled to vypadá super. Zkusím si přizpůsobit a věřím že to bude fungovat. Makro si nechám spouštět při otevření sešitu a bude to ideal.
Až to přizpůsobím, dám vědět..citovat
#013826
avatar
tak jsem se do toho pustil, castecne chapu princip a snazim se to upravit k obrazu svemu.
vytvoril jsem toto:
Sub nejmakro()
Dim p1() As Integer
Dim p2() As Integer
Dim a As Integer
Dim b As Integer
Dim x As Integer

MyFile = FileSystem.Dir(Application.ThisWorkbook.Path & "\XLS\" & "*.*")
Do While MyFile <> ""
ReDim Preserve p1(x)
p1(x) = MyFile
MyFile = FileSystem.Dir
x = x + 1
Loop

For a = 1 To 2
Cells(a, 1) = p1(a)
Cells(a, 1) = p1(a)
Next a
End Sub


prvni cast mi skenuje nazvy vsech souboru v slozce.
dale bych chtel, aby to vsechny soubory otevrelo, jako v puvodnim kódu a přečetlo v kazdem souboru tri konkretni (ve vsech stejne) bunky a jejich hodnoty vepsalo do hlavniho souboru.
Prosim o nasmerovani spravnym smerem, co se tyce kodu pro precteni tech tri bunek :) nemusi to bejt hotovej kod, jen takovy nakopnuti, rad se v tom pohrabu sam. ale nejak si nevim rady s tou syntaxi. jo a preferuju neco laikovy prehlednejsiho, napr. pole.
diky moccitovat
#013829
Opičák
Pokud máš již hotový seznam souborů, můžeš z nich z konkretní bunky "tahat" údaje např. tímto kodem.
Sub ReferToExcel()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim x As Long, y As Long

Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("C:\dokumenty_moje\pokus.xlsm")
Set ws = wb.Sheets("List1")

x = 1
y = 1

MsgBox "Row 1, Col 1 value=" & ws.Cells(x, y).Value
wb.Close False

'Quit Excel
xlApp.Quit
Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing
End Sub


cestu k souboru, list? a row + column musíš do VBA upravit podle své potřeby.
řádek msgbox pak vymazatcitovat
#013830
avatar
toto bude nadlhsie ked to chces vysvetlit :)))))

takze:


MyFile = FileSystem.Dir(Application.ThisWorkbook.Path
& "\XLS\" & "*.*")
Do While MyFile <> ""
ReDim Preserve c(x)
c(x) = MyFile
MyFile = FileSystem.Dir
x = x + 1
Loop

1. zaznamena cestu k prvemu suboru v adresari
2. do while cyklus: cykluje subory v adresaroch az kym nebude zaidny
3. pre cyklovani sa redimenzuje pole pri zachovani hodnot a zapise aktualny nazov donho

ok teraz k tvojej otazke:

- zapisal si si do pola p1() nazvi suborov
- ale v cykle si udal uz len ze pre 2 subory co ked ich budes mat 15 alebo 20 alebo 0???

preto sa pouziva zapis


For x = LBound(p1) To UBound(p1)
next

- LBound je minimalna hodnoto pola
- UBound je maximalna hodnota pola

ted k otvaraniu suborov:
nato potrebujes spravnej object zadefinovat tj. ze je to excel :P

Dim xlApp As New Excel.Application


a potom len otvoris subor:

xlApp.Workbooks.Open (Application.ThisWorkbook.Path & "\XLS\" & c(x))


- v zatvorke je priama cesta k suboru

tento zapis v nej:

Application.ThisWorkbook.Path

- da cestu k makru
- a potom sme len dopisali k tej ceste adresar XLS a meno suboru c(x)

ked uz ho mas otvoreny a chces s nim nieco robit staci pouzivat klasicke excel prikazi len pred nimi musi byt zapisane

xlApp.NIECO


po ukonceni sa musi zatvorit lebo ked budes cyklovat otvaranie tychto suborov tak sa nezavru .. aj ked ich nevidis to neznamena ze niesu otvorene preto treba zapisat:

xlApp.Workbooks(c(x)).Close


pracu s array polom uz hadam popisat nemusim nie???

ked to nebudes chapat napis ze tomu nerozumies a ja to spracvim za teba :))))))) ... viem vysvetlovat dobre neviemcitovat
#014267
avatar
Ahoj, diky za postouchnuti. Po delsim badani, jsem to konecne rozchodil k obrazu svemu. Je to trochu pomalejsi (neni to tim, ze jsem nepouzil pole pro vycuc hodnot ze souborů?), ale je to asi tim oteviranim vsech souboru.
V dalsi fazi se budu snazit z hlavniho souboru prepisovat nektere bunky v podsouborech, ale to uz bude snad jen alternativa tohohle :)
diky!

Sub nejmakro()

Dim poleNazvu()
Dim kolemNazvu()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim x As Integer
Dim xlApp As New Excel.Application

MyFile = FileSystem.Dir(Application.ThisWorkbook.Path & "\VaN\" & "*.*")
Do While MyFile <> ""
ReDim Preserve poleNazvu(x)
poleNazvu(x) = MyFile
MyFile = FileSystem.Dir
x = x + 1
Loop

a = UBound(poleNazvu) + 1
Range("A1").Value = a

ActiveSheet.Range("a3:m200").ClearContents
'For c = 0 To a - 1
'Cells(c + 3, 1) = poleNazvu(c)
'a je pocet souboru, poradi posledniho je ale a-1
'Next

For c = 0 To a - 1
xlApp.Workbooks.Open (Application.ThisWorkbook.Path & "\VaN\" & poleNazvu(c))
Cells(c + 3, 7) = xlApp.Cells(12, 3)
Cells(c + 3, 9) = xlApp.Cells(13, 19)
Cells(c + 3, 10) = xlApp.Cells(15, 19)
Cells(c + 3, 11) = xlApp.Cells(16, 19)
xlApp.Workbooks(poleNazvu(c)).Close
Next

Range("a1").Select

End Sub
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

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.

On-line nástroje