Excel - podmienka kopirovanie z viac .cvs suborov do noveho

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Uziv00
Pohlaví: Nespecifikováno

Re: Excel - podmienka kopirovanie z viac .cvs suborov do nov

Příspěvekod Uziv00 » 23 kvě 2013 23:36

Mno. Vzhledem k tomu jak spolupracuješ, tak bych se na tebe vlastně měl vykašlat.
Popis: Skript otevírá soubory C:\00.csv až C:\10.csv, kontroluje jednotlivé řádky a pokud najde ve třetím sloupci hodnotu 479, vytvoří soubor C:\result.csv, kam zkopíruje řádek, ve kterém hodnotu nalezl.
Soubory mohou mít libovolný počet řádků.
Konec práce skript oznámí.
Pokud bude nějaký soubor chybět, skript skončí chybou. Do souboru C:\result.csv bude připisovat, takže pokud budeš chtít výtah z nových souborů, musíš ho předtím vymazat.
To co je v Code si zkopíruj do textového editoru notepad (ne do Wordu!) a ulož. Změň příponu z .txt na .vbs. Spouští se poklepáním. Co ti z toho vyleze po importu do excelu netuším.

Kód: Vybrat vše

'******************************************************
'*         Script prohledává .csv soubory             *
'*      Pokud najde ve třetím sloupci hodnotu         *
'*      zapíše celý řádek do result.csv               *
'*                                                    *
'*            Vytvořeno pro PC-HELP                   *
'*            Etienn@Script v. 1.0                    *
'******************************************************

Option Explicit
Dim fso, Text1, txtStream0, txtStream, i, soubor

soubor = Array ("C:\00.csv", "C:\01.csv", "C:\02.csv", "C:\03.csv", "C:\04.csv", _
"C:\05.csv", "C:\06.csv", "C:\07.csv", "C:\08.csv", "C:\09.csv", "C:\10.csv")

Const fileout = "C:\result.csv"

' vytvoreni objektu pro pristup k souborum
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtStream0 = fso.OpenTextFile(fileout, 8, True)

For i = 0 To 10
Set txtStream = fso.OpenTextFile(soubor(i))

  Do While Not (txtStream.AtEndOfStream)
   Text1 = txtStream.ReadLine
   WScript.Echo Text1
      If InStr(Text1, ";479;") Then txtStream0.WriteLine Text1   
  Loop   
 
Next
txtStream0.Close
MsgBox "Script proběhl", vbOKOnly + vbInformation, "Zpráva"

Set fso = Nothing

Reklama
DestinySVK
nováček
Příspěvky: 9
Registrován: leden 12
Pohlaví: Muž
Stav:
Offline

Re: Excel - podmienka kopirovanie z viac .cvs suborov do nov

Příspěvekod DestinySVK » 24 kvě 2013 07:53

Hmm po spusteni mi ten script pri kazdom riadku vyhodi tabulku s datami jedneho riadku a musim to odklikat...
result subor je prazdny...
**************
script som upravil uz pridava data...
este to odklikavanie po riadku odstranit...
odstranene...

este posledny test pri velkych datach...

tak vdaka funguje to uz si to sam prisposobim potom ako budem potrebovat.

Uziv00
Pohlaví: Nespecifikováno

Re: Excel - podmienka kopirovanie z viac .cvs suborov do nov

Příspěvekod Uziv00 » 24 kvě 2013 08:53

Aha, nechal jsem tam testovací Wscript.Echo.
Fajn. Tak označ téma za vyřešené.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • EXCEL -jak otevřít 2 excel sobory abych je viděla současne a samostatně
    od Ketty02 » 30 srp 2024 21:19 » v Vše ostatní (sw)
    2
    4807
    od Riviera kid Zobrazit poslední příspěvek
    02 zář 2024 16:21
  • Přechod z Excel 21 na Excel 24
    od Snekment » 29 led 2025 13:46 » v Kancelářské balíky
    2
    12223
    od Snekment Zobrazit poslední příspěvek
    29 led 2025 15:05
  • Stavba „nového“ PC
    od thetommys » 07 čer 2025 11:43 » v Rady s výběrem hw a sestavením PC
    2
    1821
    od thetommys Zobrazit poslední příspěvek
    07 čer 2025 18:05
  • Sestavení nového herního PC
    od Toodles » 05 říj 2024 23:51 » v Rady s výběrem hw a sestavením PC
    3
    1916
    od Toodles Zobrazit poslední příspěvek
    07 říj 2024 18:32
  • Sestavení nového herního PC
    od davolten2 » 11 pro 2024 16:21 » v Rady s výběrem hw a sestavením PC
    5
    1583
    od petr22 Zobrazit poslední příspěvek
    11 pro 2024 22:03

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti