autor: http://www.hackwars.pl/vba-excel-pobieranie-danych-roznych-plikow/

ThisWorkbook.Path – Właściwość Path skoroszytu Excela określa pełną ścieżkę katalogu, w którym znajduje się dany plik – dzięki czemu możemy sobie odpuścić ścieżkę F:\Problem_solving, i dzięki czemu gdzie byśmy nie przenieśli katalogu głównego (Problem_solving) makro nadal będzie działać.
Workbooks.Open(Filename:=plik) – metoda odpowiedzialna za otwarcie konkretnego pliku
wb.Saved = True – zapisywanie otwartych plików – dzięki czemu przed zamknięciem nie będzie excel wyświetlał powiadomień z zapytaniem czy zapisać.
wb.Close – metoda Close – zamyka plik

 

KOD DLA POTOMNOŚCI 

Sub problem_solving()
Application.ShowWindowsInTaskbar = False ‚ wyłaczamy aktualizacje taskbara
Application.ScreenUpdating = False ‚ wylaczamy aktualizacje tego co sie dzieje na ekranie podczas pracy makra
Dim kom1 As Range ‚ zestawienie
Dim kom2 As Range ‚ filestocheck
Dim newkom1 As Range ‚ arkusz1 – dla plików z których pobieramy dane

For Each kom1 In Sheets(„zestawienie”).Range(„a4:a15”) ‚ zakres w arkuszu zestawienie w ktorym znajduja sie nazwy dzialow

‚tworzymy i zerujemy sobie zmienne dla kazdego miesiaca
styczen = 0
luty = 0
marzec = 0
kwiecien = 0
maj = 0
czerwiec = 0
lipiec = 0
sierpien = 0
wrzesien = 0
pazdziernik = 0
listopad = 0
grudzien = 0
starsze = 0
rest = 0

For Each kom2 In Sheets(„FilesToCheck”).Range(„A4:a15”) ‚ zakres w arkuszu FilesToCheck w ktorym znajduja się nazwy dzialow
brak_pliku = False
If (kom1.Value = kom2.Value) Then ‚jesli dzial z zestawienia bedzie sie rownal dzialowi z filestochec to wykonaj to:
lokalizacja = kom2.Offset(0, 1).Value
nazwa_pliku = kom2.Offset(0, 2).Value
kol = kom2.Offset(0, 3).Value ‚ kolumna która należy przeszukiwac w plikach do sprawdzenia
wier = kom2.Offset(0, 4).Value ‚ wiersz od ktorego należy rozpocząć przeszukiwania w plikach do sprawdzenia
plik = ThisWorkbook.Path & „\” & lokalizacja & „\” & nazwa_pliku ‚ sciezka do konkretnego pliku

If Dir(plik) <> „” Then ‚ sprawdzamy czy plik jest pusty / jesli nie jest to wchodzimy do środka
Set wb = Workbooks.Open(Filename:=plik) ‚ ustawiamy zmienna wb na dany skoroszyt

wb.Worksheets(„Arkusz1”).Range(kol & wier).End(xlDown).Select ‚ szukamy ostatniego wiersza do przeszukiwania
ostatni_wier = ActiveCell.Row + 1 ‚ ustawiamy ostatni wolny wiersz

For Each newkom1 In wb.Worksheets(„Arkusz1”).Range(kol & wier & „:” & kol & ostatni_wier) ‚ sprawdzamy zakres danych w plikach z których chcemy zebrać dane

If (newkom1.Value = „S”) Then
rok = Year(newkom1.Offset(0, -2).Value)
miesiac = Month(newkom1.Offset(0, -2).Value)

If (rok < Year(Now)) Then

starsze = starsze + 1

Else ‚(rok < Year(Now))

Select Case miesiac ‚ instrukcja warunkowa case dzięki której mozemy podliczyć otwarte projekty w zależności od miesiąca
Case 1: styczen = styczen + 1
Case 2: luty = luty + 1
Case 3: marzec = marzec + 1
Case 4: kwiecien = kwiecien + 1
Case 5: maj = maj + 1
Case 6: czerwiec = czerwiec + 1
Case 7: lipiec = lipiec + 1
Case 8: sierpien = sierpien + 1
Case 9: wrzesien = wrzesien + 1
Case 10: pazdziernik = pazdziernik + 1
Case 11: listopad = listopad + 1
Case 12: grudzien = grudzien + 1
Case Else: rest = rest + 1
End Select

End If ‚ else (rok < Year(Now))

End If ‚(newkom1.Value = „S”)

Next ‚ end newkom1

wb.Saved = True ‚ zapisujemy plik
wb.Close ‚ zamykamy

Else
brak_pliku = True
Exit For

End If ‚ Dir(plik) <> „”

End If ‚(kom1.Value = kom2.Value)

Next
‚ zapisujemy dane w arkuszu zestawienie w odpowiednich komórkach (offset – przypisuje do odpowiedniego miesiaca – jest to przesunięcie względem komórki która przeszukujemy)
kom1.Offset(0, 1).Value = styczen
kom1.Offset(0, 2).Value = luty
kom1.Offset(0, 3).Value = marzec
kom1.Offset(0, 4).Value = kwiecien
kom1.Offset(0, 5).Value = maj
kom1.Offset(0, 6).Value = czerwiec
kom1.Offset(0, 7).Value = lipiec
kom1.Offset(0, 8).Value = sierpien
kom1.Offset(0, 9).Value = wrzesien
kom1.Offset(0, 10).Value = pazdziernik
kom1.Offset(0, 11).Value = listopad
kom1.Offset(0, 12).Value = grudzien
kom1.Offset(0, 13).Value = starsze
kom1.Offset(0, 15).Value = rest

kom1.Offset(0, 14).Value = brak_pliku
Next

Application.ScreenUpdating = True
Application.ShowWindowsInTaskbar = ShwWndsTask

End Sub

WordPress Themes