Izpisovanje vrednosti iz datotek *.xls

Pomoč pri izdelavi makrov
Odgovori
deraleks
Prispevkov: 24
Pridružen: Sr Feb 28, 2007 10:28 pm

Izpisovanje vrednosti iz datotek *.xls

Odgovor Napisal/-a deraleks »

V mapi imam več datotek *.xls, ki imajo enako strukturo. Iz vsake datoteke bi rad v aktivno datoteko izpisal vrednost določene celice (recimo Cells(9, 4).Value). V prvem stolpcu izpisa naj bi bilo navedeno ime datoteke, v drugem stolpcu pa vrednost posamezne celice iz datotek. Ali je to težko?

lp
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Izpisovanje vrednosti iz datotek *.xls

Odgovor Napisal/-a admin »

Na vprašanje "Ali je to težko?", lahko pričakujete kvečjemu odgovor Da ali Ne in ne vem kako naj bi vam to pomagalo. Torej odgovor na vaše vprašanje je NE :)...

No samo rešitev pa najdete tukajle.
lp,
Matjaž Prtenjak
Administrator
deraleks
Prispevkov: 24
Pridružen: Sr Feb 28, 2007 10:28 pm

Re: Izpisovanje vrednosti iz datotek *.xls

Odgovor Napisal/-a deraleks »

Rabil bi malenkost drugačno rešitev, ki izpiše vrednost iz iste celice vsake datoteke.
Sem pobrskal po vašem forumu in malo po netu ter sestavil tole, vendar je nekaj narobe:

Koda: Izberi vse

Sub Izvlacenje2()
     
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
     
    InitialFoldr$ = "C:\Excel\" '<<< Startup folder to begin searching from
     
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
            
            Do While xFname$ <> ""
                ActiveCell.Offset(xRow) = xDirect$
                ActiveCell.Offset(xRow, 1) = xFname$
                Workbooks.Open xDirect$ & xFname$
                ThisWorkbook.Sheets(1).Cells(Datoteka + 1, 2).Value = Workbooks(xDirect$ & xFname$).Sheets(1).Cells(9, 4).Value
                Workbooks(xDirect$ & xFname$).Close SaveChanges:=False
                xRow = xRow + 1
                xFname$ = Dir
            Loop
        End If
    End With
    
    ThisWorkbook.Close SaveChanges:=True
    
End Sub
 
Mogoče veste kje je problem?

lp 8)
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Izpisovanje vrednosti iz datotek *.xls

Odgovor Napisal/-a admin »

deraleks napisal/-a:...vendar je nekaj narobe:...
In kaj je narobe? Kaj ne deluje? Malo opišite kaj želite in kaj vam naredi makro, potem pa bomo videli, kaj bi lahko bilo narobe....
lp,
Matjaž Prtenjak
Administrator
deraleks
Prispevkov: 24
Pridružen: Sr Feb 28, 2007 10:28 pm

Re: Izpisovanje vrednosti iz datotek *.xls

Odgovor Napisal/-a deraleks »

Ko zaženem makro se le-ta ustavi v vrstici:

Koda: Izberi vse

ThisWorkbook.Sheets(1).Cells(Datoteka + 1, 2).Value = Workbooks(xDirect$ & xFname$).Sheets(1).Cells(9, 4).Value
Napiše se opozorilo Subscript out of range.

Želim:
1 stolpec pot
2 stolpec ime file
3 stolpec vrednost celice Cellls(9, 4) vsakega file v mapi

lp :?:
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Izpisovanje vrednosti iz datotek *.xls

Odgovor Napisal/-a admin »

Uf... ste imeli kar nekaj napak. No jaz sem vam popravil tako, da sem pustil vašo kodo in samo popravil tako, da deluje.

Koda: Izberi vse

Option Explicit

    Sub Izvlacenje2()
         
        Dim xRow As Long: xRow = 1
        Dim xDirect$, xFname$, InitialFoldr$
        Dim list As Worksheet: Set list = ActiveSheet
         
        InitialFoldr$ = "C:\Excel\" '<<< Startup folder to begin searching from
         
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = Application.DefaultFilePath & "\"
            .Title = "Please select a folder to list Files from"
            .InitialFileName = InitialFoldr$
            .Show
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
                xFname$ = Dir(xDirect$, 7)
               
                Do While xFname$ <> ""
                    list.Cells(xRow, 1) = xDirect$
                    list.Cells(xRow, 2) = xFname$
                    Workbooks.Open xDirect$ & xFname$
                    list.Cells(xRow, 3) = ActiveWorkbook.Sheets(1).Cells(9, 4).Value
                    ActiveWorkbook.Close SaveChanges:=False
                    xRow = xRow + 1
                    xFname$ = Dir
                Loop
            End If
        End With
       
        ThisWorkbook.Close SaveChanges:=True
       
    End Sub

lp,
Matjaž Prtenjak
Administrator
deraleks
Prispevkov: 24
Pridružen: Sr Feb 28, 2007 10:28 pm

Rešitev

Odgovor Napisal/-a deraleks »

Se zahvaljujem za popravke. Skoraj neverjetno je, koliko tak makro olajša delo, vendar je potrebno precizno spisati kodo. V nadaljevanju bi me zanimlao, kaj je potrebno spremeniti, da bi makro listal po file-ih v ne samo v mapi, ampak tudi v podmapah te mape?

lp :D
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Re: Izpisovanje vrednosti iz datotek *.xls

Odgovor Napisal/-a admin »

Če ukaz Dir preoblikujete takole:

Koda: Izberi vse

xFname$ = Dir(xDirect$, 23)
(prej je pisalo 7, zdaj pa 23!), potem bi vaš makro izlistal tudi vse podmape izbrene mape, vendar pa bi potem vaš makro tudi takoj javil napako, saj bi podmapo poskušal odpreti kot Excelovo datoteko, kar pa seveda ne gre :)... Zatorej je potrebno makro popraviti tako, da za vsak element, ki ga funkcija DIR vrne ugotovi ali gre za podmapo in v tem primeru izlista še elemente te podmape (najbolje rekurzivno). V kolikor pa naleti na datoteko, pa je potrebno najprej ugotoviti ali je to Excelova datoteka (najlažje preko končnice) in če je jo odpreti in prebrati, sicer pa preskočiti...

Vsekakor malce preveč, da bi vam ga zapisal v forum :(
lp,
Matjaž Prtenjak
Administrator
Odgovori