použil bych záznam makra a naimportoval požadovaný souborcitovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: vytvoření takového menšího "feedu"
MS Excel
Téma: vytvoření takového menšího "feedu" 
Zaslal/a 30.6.2014 11:56
Dobrý den pánové, měl bych tady takový menší oříšek - alespoň teda pro mě.
Dostávám od dodavatele několik textových souborů, kde jsou uvedeny jednotlivé modely (každý model na jeden řádek). Každý ten soubor je trošku odlišný každý týden(Množství modelů, trochu upravené názvy).
Potřeboval bych nějak zautomatizovat naimportování jednotlivých položek do svého excelového souboru (např. do sloupce A). Tak, abych to nemusel ručně kopírovat. Pro mě by bylo nejvýhodnější, kdyby tam byla nějaká pevná cesta - např. C:/dokumenty/soubor.txt ... a z toho by se to importovalo do sloupce A. Pokud bych ten soubor přepsal, tak by se změny projevily (naimportovaly) i do toho excelovém souboru. Umí tohle excel vůbec?
Přemýšlel jsem, že bych v nejhorším textové soubory házel na FTP a nechal to importovat do google docs (to vím, že to jde) ... bylo by s tím ale více práce.
Díky za odpovědi.
Pokiaľ budú tie texťáky v jednom adresári, tak napr. takto (makro vygeneruje vždy celý zoznam odznova - do stĺpca A prvého listu naimportuje postupne všetky riadky jednotlivých *.txt súborov z daného adresára):Sub test()
Dim Riadok As String, Cesta As String, Atr As String, Meno As String, myArray() As Variant, i As Long
Cesta = "C:\Documents and Settings\Desktop\" 'sem zadaj adresar, z ktoreho chces nacitat
Atr = vbNormal
Meno = Dir(Cesta, Atr)
Do While Meno <> ""
If Meno Like "*.txt" Then
Open Cesta & Meno For Input As #1
Do While Not EOF(1)
Line Input #1, Riadok
ReDim Preserve myArray(i)
myArray(i) = Riadok
i = i + 1
Loop
Close #1
End If
Meno = Dir
Loop
' vystup na prvy list do stlpca A
Sheet1.[A:A].ClearContents
Sheet1.[A1].Resize(UBound(myArray, 1) + 1, 1) = WorksheetFunction.Transpose(myArray)
End Subcitovat
Dim Riadok As String, Cesta As String, Atr As String, Meno As String, myArray() As Variant, i As Long
Cesta = "C:\Documents and Settings\Desktop\" 'sem zadaj adresar, z ktoreho chces nacitat
Atr = vbNormal
Meno = Dir(Cesta, Atr)
Do While Meno <> ""
If Meno Like "*.txt" Then
Open Cesta & Meno For Input As #1
Do While Not EOF(1)
Line Input #1, Riadok
ReDim Preserve myArray(i)
myArray(i) = Riadok
i = i + 1
Loop
Close #1
End If
Meno = Dir
Loop
' vystup na prvy list do stlpca A
Sheet1.[A:A].ClearContents
Sheet1.[A1].Resize(UBound(myArray, 1) + 1, 1) = WorksheetFunction.Transpose(myArray)
End Subcitovat
(30.6.2014 13:45)#020247
Zkoušel jsem to makro, a hází mi to chybu.
Runtime error 9 - Subscript out of range
Zadal jsem tam cestu C:\feed\
Změnil Sheet1 na List1citovat
Runtime error 9 - Subscript out of range
Zadal jsem tam cestu C:\feed\
Změnil Sheet1 na List1citovat
Runtime error 9 - Subscript out of range
mi hodí, keď zadám cestu:
Cesta = "C:\feed\"
si si istý, že daný adresár skutočne existuje? Ja taký adresár vytvorený u seba nemám, keď ho vložím do kódu, dá mi tiež uvedenú chybu.
Změnil Sheet1 na List1. Prečo? Kódové okno listu je Sheet1, nie List1... Tak toto nemeň. Skontroluj si, či máš v C:\feed\ nejaké .txt súbory k importu, o.k.? V opačnom prípade vlož do cesty adresár, v ktorom sa tie *.txt skutočne nachádzajú.
edit:
Tá chyba v tomto prípade hovorí, že myArray sa nevytvoril. To je spôsobené buď tým, že je špatne zapísaná cesta v premennej cesta (adresár, v ktorom majú byť *.txt, súbory), t.j. buď daný adresár neexistuje, alebo sa v ňom žiadne .txt nenachádzajú.citovat
mi hodí, keď zadám cestu:
Cesta = "C:\feed\"
si si istý, že daný adresár skutočne existuje? Ja taký adresár vytvorený u seba nemám, keď ho vložím do kódu, dá mi tiež uvedenú chybu.
Změnil Sheet1 na List1. Prečo? Kódové okno listu je Sheet1, nie List1... Tak toto nemeň. Skontroluj si, či máš v C:\feed\ nejaké .txt súbory k importu, o.k.? V opačnom prípade vlož do cesty adresár, v ktorom sa tie *.txt skutočne nachádzajú.
edit:
Tá chyba v tomto prípade hovorí, že myArray sa nevytvoril. To je spôsobené buď tým, že je špatne zapísaná cesta v premennej cesta (adresár, v ktorom majú byť *.txt, súbory), t.j. buď daný adresár neexistuje, alebo sa v ňom žiadne .txt nenachádzajú.citovat
(30.6.2014 14:07)#020249
Tak už to funguje dobře :). Problém byl v tom, že v tom kódu je napsáno *.txt a ty soubory, které importuju jsou v .TXT :)
Sheet na list sem musel změnit. Jinak to psalo object required.
Každopádně díky moc za bleskovou pomoc :).
P.S.: Nešlo by to nějak nastavit, aby se to aktualizovalo hned po otevření dokumentu? Teď to dělám tak, že otevřu dokument, alt+f11, dám spustitcitovat
Sheet na list sem musel změnit. Jinak to psalo object required.
Každopádně díky moc za bleskovou pomoc :).
P.S.: Nešlo by to nějak nastavit, aby se to aktualizovalo hned po otevření dokumentu? Teď to dělám tak, že otevřu dokument, alt+f11, dám spustitcitovat
Písal si, že súbory majú príponu txt, nie TXT :) Stačí príslušný riadok prepísať na:If LCase(Meno) Like "*.txt" Then Nešlo by to nějak nastavit, aby se to aktualizovalo hned po otevření dokumentu? Do kódového okna ThisWorkbook vlož:Private Sub Workbook_Open()
Call test
End Sub Inak, k sub rutinám, ktoré nie sú Private, máš prístup priamo z excelu prostredníctvom Alt+F8. Za mystifikáciu so Sheet/List sa ospravedlňujem, mám anglický excel, kódový názov listu je potom Sheetxxx, v českej lokalizácii Listxxx, toto Microsoft pmn nedomyslel a makro tak bez úprav nie je prenositeľné medzi rôznymi lokalizáciami.citovat
Call test
End Sub Inak, k sub rutinám, ktoré nie sú Private, máš prístup priamo z excelu prostredníctvom Alt+F8. Za mystifikáciu so Sheet/List sa ospravedlňujem, mám anglický excel, kódový názov listu je potom Sheetxxx, v českej lokalizácii Listxxx, toto Microsoft pmn nedomyslel a makro tak bez úprav nie je prenositeľné medzi rôznymi lokalizáciami.citovat
(30.6.2014 14:53)#020253
Tak jsem to zkusil a píše to
Compile Error:
Sub or Function not defined
možná sem zapoměl něco přepsat podle lokalizace?citovat
Compile Error:
Sub or Function not defined
možná sem zapoměl něco přepsat podle lokalizace?citovat
možná sem zapoměl něco přepsat podle lokalizace?
Ne. Zmenil si názov makra, tak ho musíš zmeniť i v tej druhej rutine (Private Sub Workbook_Open())citovat
Ne. Zmenil si názov makra, tak ho musíš zmeniť i v tej druhej rutine (Private Sub Workbook_Open())citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články