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
Izpisovanje vrednosti iz datotek *.xls
Re: Izpisovanje vrednosti iz datotek *.xls
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.
No samo rešitev pa najdete tukajle.
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Izpisovanje vrednosti iz datotek *.xls
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:
Mogoče veste kje je problem?
lp
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
lp
Re: Izpisovanje vrednosti iz datotek *.xls
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....deraleks napisal/-a:...vendar je nekaj narobe:...
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator
Re: Izpisovanje vrednosti iz datotek *.xls
Ko zaženem makro se le-ta ustavi v vrstici:
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
Koda: Izberi vse
ThisWorkbook.Sheets(1).Cells(Datoteka + 1, 2).Value = Workbooks(xDirect$ & xFname$).Sheets(1).Cells(9, 4).Value
Želim:
1 stolpec pot
2 stolpec ime file
3 stolpec vrednost celice Cellls(9, 4) vsakega file v mapi
lp
Re: Izpisovanje vrednosti iz datotek *.xls
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
Matjaž Prtenjak
Administrator
Rešitev
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
lp
Re: Izpisovanje vrednosti iz datotek *.xls
Če ukaz Dir preoblikujete takole:
(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
Koda: Izberi vse
xFname$ = Dir(xDirect$, 23)
Vsekakor malce preveč, da bi vam ga zapisal v forum
lp,
Matjaž Prtenjak
Administrator
Matjaž Prtenjak
Administrator