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