..|| Blog || Produkti/Storitve || MExcel || MDodatki || 300 nasvetov ||..

Izpisovanje vrednosti iz datotek *.xls

Pomoč pri izdelavi makrov

Izpisovanje vrednosti iz datotek *.xls

OdgovorNapisal/-a deraleks » Sr avg 18, 2010 11:07 am

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
deraleks
 
Prispevkov: 23
Pridružen: Sr feb 28, 2007 10:28 pm



Matjazev.NET
 

Re: Izpisovanje vrednosti iz datotek *.xls

OdgovorNapisal/-a admin » Sr avg 18, 2010 8:40 pm

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
admin
Site Admin
 
Prispevkov: 3492
Pridružen: Sr jul 20, 2005 10:06 pm

Re: Izpisovanje vrednosti iz datotek *.xls

OdgovorNapisal/-a deraleks » Če avg 19, 2010 12:16 pm

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)
deraleks
 
Prispevkov: 23
Pridružen: Sr feb 28, 2007 10:28 pm

Re: Izpisovanje vrednosti iz datotek *.xls

OdgovorNapisal/-a admin » Če avg 19, 2010 1:34 pm

deraleks je 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
admin
Site Admin
 
Prispevkov: 3492
Pridružen: Sr jul 20, 2005 10:06 pm

Re: Izpisovanje vrednosti iz datotek *.xls

OdgovorNapisal/-a deraleks » Pe avg 20, 2010 2:50 pm

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 :?:
deraleks
 
Prispevkov: 23
Pridružen: Sr feb 28, 2007 10:28 pm

Re: Izpisovanje vrednosti iz datotek *.xls

OdgovorNapisal/-a admin » Pe avg 20, 2010 6:16 pm

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
admin
Site Admin
 
Prispevkov: 3492
Pridružen: Sr jul 20, 2005 10:06 pm

Rešitev

OdgovorNapisal/-a deraleks » Po avg 23, 2010 8:37 am

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
deraleks
 
Prispevkov: 23
Pridružen: Sr feb 28, 2007 10:28 pm

Re: Izpisovanje vrednosti iz datotek *.xls

OdgovorNapisal/-a admin » Po avg 23, 2010 2:32 pm

Č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
admin
Site Admin
 
Prispevkov: 3492
Pridružen: Sr jul 20, 2005 10:06 pm


Vrni se na VBA

Kdo je prisoten

Po forumu brska: 0 registriranih uporabnikov in 0 gostov

cron