Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 64041 Skopiuj do schowka Makro pobieranie danych z pliku
Autor Wiadomość
cezaryfcb89 
Starszy Forumowicz


Posty: 26
Wysłany: 05-02-2019, 09:52   Makro pobieranie danych z pliku

Cześć,
mam pytanie czy jest możliwość zmiany mojego makra które pobiera ze ścieżki wstawionej w kolumnie A1 nazwy plików które są w danym folderze w kolumnach (A3, A4, itd.) aby pobierały również oprócz nazwy pliku (są to pliki Excel) wartości z tej samej kolumny np. B3 z arkusza o nazwie np.: Faktury (zawsze są dwa arkusze Arkusz1, Faktury)
Kod:

Public Sub Dzajo()

 Dim Katalog As String
 Dim NazwaPliku As String
 Dim IndexSheet As Worksheet
 Dim KolejnyWiersz As Long

 KolejnyWiersz = 3

 Set IndexSheet = ThisWorkbook.ActiveSheet
 Katalog = Range("A1").Value
 Katalog = Katalog & "\"

 NazwaPliku = Dir(Katalog & "*.*")
 Do While NazwaPliku <> ""
 IndexSheet.Cells(KolejnyWiersz, 1).Value = NazwaPliku
 KolejnyWiersz = KolejnyWiersz + 1
 NazwaPliku = Dir
 Loop

 Set IndexSheet = Nothing
 End Sub
ID posta: 361976 Skopiuj do schowka
 
 
BrunO 
ExcelSpec



Pomógł: 119 razy
Posty: 513
Wysłany: 05-02-2019, 10:23   

Sprawdź, czy zadziała:

Kod:
Public Sub Dzajo()

Dim Katalog As String
Dim NazwaPliku As String
Dim IndexSheet As Worksheet
Dim KolejnyWiersz As Long

KolejnyWiersz = 3

Set IndexSheet = ThisWorkbook.ActiveSheet
Katalog = Range("A1").Value
Katalog = Katalog & "\"

NazwaPliku = Dir(Katalog & "*.*")
Do While NazwaPliku <> ""
IndexSheet.Cells(KolejnyWiersz, 1).Value = NazwaPliku


'TO DODAŁEM
Workbooks.Open Katalog & "\" & NazwaPliku
IndexSheet.Cells(KolejnyWiersz, 2).Value = ActiveSheet.ActiveWorkbook.Sheets("Faktury").Range("B3").Value 'To B3 to tak na pałę wstawiłem, bo mało konkretnie to opisałeś
ActiveWindow.Close


KolejnyWiersz = KolejnyWiersz + 1
NazwaPliku = Dir
Loop

Set IndexSheet = Nothing
End Sub
ID posta: 361978 Skopiuj do schowka
 
 
kalep 
świeżak


Posty: 8
Wysłany: 14-02-2019, 14:41   

Tak przypadkiem zajrzałem tutaj w poszukiwaniu podobnego rozwiązania i chciałem skorzystać ale, wykłada się na linii:
Kod:

IndexSheet.Cells(KolejnyWiersz, 2).Value = ActiveSheet.ActiveWorkbook.Sheets("Faktury").Range("B3").Value



Chyba, że źle zrozumiałem intencje autora..

A jak przerobić poniższy kod aby również czytał nazwy katalogów, a nie tylko plików w nim zawartych?
Kod:
Public Sub Dzajo()

 Dim Katalog As String
 Dim NazwaPliku As String
 Dim IndexSheet As Worksheet
 Dim KolejnyWiersz As Long

 KolejnyWiersz = 3

 Set IndexSheet = ThisWorkbook.ActiveSheet
 Katalog = Range("A1").Value
 Katalog = Katalog & "\"

 NazwaPliku = Dir(Katalog & "*.*")
 Do While NazwaPliku <> ""
 IndexSheet.Cells(KolejnyWiersz, 1).Value = NazwaPliku
 KolejnyWiersz = KolejnyWiersz + 1
 NazwaPliku = Dir
 Loop

 Set IndexSheet = Nothing
 End Sub
  
ID posta: 362611 Skopiuj do schowka
 
 
Tajan


Pomógł: 4258 razy
Posty: 9475
Wysłany: 14-02-2019, 15:13   

Powinno być:
Kod:
IndexSheet.Cells(KolejnyWiersz, 2).Value =  ActiveWorkbook.Sheets("Faktury").Range("B3").Value
(zapis w jednej linii) oczywiście, zakładając, że w każdym z otwieranych plików znajduje się arkusz "Faktury".
kalep napisał/a:
A jak przerobić poniższy kod aby również czytał nazwy katalogów
Co przez to rozumiesz? Skąd ma to czytać? W tej chwili nazwa katalogu jest odczytywana z komórki A1 a jak to ma być według ciebie?
  
ID posta: 362613 Skopiuj do schowka
 
 
kalep 
świeżak


Posty: 8
Wysłany: 15-02-2019, 07:30   

Moje pytanie było do pierwszego wpisu.
Tak z katalogu, tutaj wszystko OK. Szukałem rozwiązania na czytanie wszystkiego w katalogu również nazw folderów.
Jeszcze raz zapytam:
To makro poniżej czyta nazwy plików ze wskazanego katalogu w komórce A1:
Kod:
Public Sub Dzajo()

 Dim Katalog As String
 Dim NazwaPliku As String
 Dim IndexSheet As Worksheet
 Dim KolejnyWiersz As Long

 KolejnyWiersz = 3

 Set IndexSheet = ThisWorkbook.ActiveSheet
 Katalog = Range("A1").Value
 Katalog = Katalog & "\"

 NazwaPliku = Dir(Katalog & "*.*")
 Do While NazwaPliku <> ""
 IndexSheet.Cells(KolejnyWiersz, 1).Value = NazwaPliku
 KolejnyWiersz = KolejnyWiersz + 1
 NazwaPliku = Dir
 Loop

 Set IndexSheet = Nothing
 End Sub

Chciałbym, aby czytało również nazwy katalogów, a nie wyłącznie plików.
Przepraszam, ale nie "siedzę" na codzień w VBA, pewnie to banalne.
Proszę o pomoc.
  
ID posta: 362630 Skopiuj do schowka
 
 
Tajan


Pomógł: 4258 razy
Posty: 9475
Wysłany: 15-02-2019, 09:37   

Potrzebna jest taka zmiana kodu:
Kod:
 NazwaPliku = Dir(Katalog & "*.*", vbDirectory)
 Do While NazwaPliku <> ""
    If NazwaPliku <> "." And NazwaPliku <> ".." Then
       IndexSheet.Cells(KolejnyWiersz, 1).Value = NazwaPliku
       KolejnyWiersz = KolejnyWiersz + 1
    End If
    NazwaPliku = Dir
 Loop
ID posta: 362639 Skopiuj do schowka
 
 
Zbiniek 
Excel Expert



Zaproszone osoby: 2
Pomógł: 403 razy
Posty: 2572
Wysłany: 15-02-2019, 10:14   

Poniżej przykład za pomocą PowerQuery. Pamiętaj, aby zmienić folder.
Kod:
let
    Źródło = Folder.Files("D:\Twój Folder"),
    #"Dodano kolumnę niestandardową" = Table.AddColumn(Źródło, "Pełna ścieżka", each [Folder Path]&[Name])
in
    #"Dodano kolumnę niestandardową"
_________________
pozdrawiam
Zbiniek

Pisz po polsku! Jest różnica czy siedzisz w sadzie czy w sądzie. "Język polski jest ą-ę" :-)

Prawdopodobieństwo otrzymania satysfakcjonującej odpowiedzi jest proporcjonalne do właściwego sformułowania problemu (popartego załącznikiem).

Jest załącznik - jest impreza

http://rtfm.killfile.pl/
ID posta: 362640 Skopiuj do schowka
 
 
kalep 
świeżak


Posty: 8
Wysłany: 15-02-2019, 12:46   

Działa doskonale, o to mi chodziło :-)
Dziękuję za pomoc.
ID posta: 362657 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe