Delni uvoz vsebine iz TXT v Excel

[drglzr]

Pozdravljeni,

Na forumu (http://www.matjazev.net/forum/viewtopic ... &hilit=txt) sem našel (z vašo pomočjo modificirano) kodo "PaPaDiZ-a", ki uvaža iz TXT datoteke v Excel. Vsebino sem uspel prirediti svojim potrebam, vendar pa koda uvozi celotno vsebino želene datoteke, česar pa ne želim. Želel bi namreč uvoziti le posamezne vrstice, ki vsebujejo določen tekst (npr. "IME"). V kodo sem poskušal vstaviti If zanko, kar pa mi ne uspe (saj vem – ukvarjam se s stvarmi, ki jim nisem kos, vendar bi mi to MOČNO, MOČNO olajšalo izvajanje določene rutine). Prosim, če mi lahko pomagate.

V naprej hvala.

[admin]

Pozdravljeni,

Prilepite kodo, ki jo imate - pravite, da ste jo priredili svojim potrebam - in vam bom povedal kam gre IF stavek... (pa ne pozabite kode zapredi v CODE, da bo berljiva).

[drglzr]

Pozdravljeni.

Ne gre za kakšno posebno priredbo kode. Po predlogi, ki ste jo podali na omenjeni povezavi sem zamenjal napovedni stavek "With", priredil "False" in "True" ter število in širino stolpcev. Nato pa sem na 100 in 1 način poskušal z zamenjavo "TEXT;" (v moji nevednosti sem prišel do spoznanja, da mora očitno ostati). Zato sem skušal z določitvijo dodatnih spremenljivk in z nebroj različnih zapisov If/Then zanke. Vendar nič "kruha". Težava je še v tem, da najverjetneje ne znam pravilno zapisati zanke, ki bi povedala: "Če najdeš "IME", potem kopiraj celo vrstico". In sedaj sem na tem, da vse skupaj "vržem v koš".

Koda je sicer pripeta, vendar ...

Lp

Koda: Izberi vse

Sub UvozIzTxt()

'
  Dim IzbranaDatoteka

  IzbranaDatoteka = Application.GetOpenFilename
  If Not (IzbranaDatoteka <> False) Then Exit Sub
     
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & IzbranaDatoteka _
            , Destination:=ActiveCell)
   
            .Name = "Podatki"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = xlWindows
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(6, 9, 7, 8, 16, 11, 3, 16, 10, 52)
            .Refresh BackgroundQuery:=False
        End With
    End Sub

[admin]

Pozdravljeni,

Koda iz katere ste izhajali ne more iz datoteke prebrati samo določene vrstice, lahko pa prebere samo določene stolpce, kar pa vam ne ustreza.

Za vaš problem morate datoteko brati sami in izločati ustrezne vrstice, ter jih zapisovati v Excel... A ker pravite, da imate uvoz datoteke v Excel že narejen, sam vam problem rešil malce drugače. Spodaj sem vam napisal funkcijo, ki bo prala vhodno datoteko ter vse vrstice, ki jih želite uvoziti v Excel prepisala v drugo (izhodno) datoteko. Potem pa vi z vašo že napisano funkcijo samo uvozite to novo datoteko v kateri se nahajajo samo vrstice, ki vam ustrezajo.ž

Kodo sem komentiral, tako da vam bo jasno kaj in kje se dogaja:

Koda: Izberi vse

Sub FiltrirajDatoteko()
  ' določimo imena datotek
  Dim vhod As String: vhod = "c:\help\vhod.txt"
  Dim izhod As String: izhod = "c:\help\rezultat.txt"
  
  ' odpremo vhodno in izhodno datoteko
  Open vhod For Input As #1
  Open izhod For Output As #2
  
  ' beremo vhodno datoteko, dokler je ni konec
  Dim vrstica As String
  Do While Not EOF(1)
    ' preberemo vrstico iz datoteke
    Line Input #1, vrstica
    
    ' če vrstica vsebuje iskano besedo potem jo prepišemo
    ' v izhodno datoteko
    If InStr(vrstica, "IME") > 0 Then
      Print #2, vrstica
    End If
  Loop
  
  ' zapremo obe datoteki
  Close #2
  Close #1
  
  ' tukaj pa lahko vi sedaj z vašo kodo uvozite
  ' izhodno datoteko...
  ' With ActiveSheet.QueryTables.Add(Connection:= _
  '     "TEXT;" & izhod, Destination:=ActiveCell)
  '         .Name = "Podatki"
  '         .FieldNames = True
  '         ... in tako dalje ...
End Sub

[drglzr]

Pozdravljeni.
Kdor zna, zna. Zadeva teče, kot po maslu. Najlepša hvala.
Lp