VBA Excel Pobieranie danych z różnych plików

utworzone przez dsp_dozorca | gru 29, 2017 | Blog, Porady, Software, Wiedza | 0 komentarzy

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 którym znajdują się nazwy działów

'tworzymy i zerujemy sobie zmienne dla każdego miesiąca
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

VBA Opisy post poleceń

utworzone przez dsp_dozorca | gru 29, 2017 | Blog, Porady, Software, Wiedza | 0 komentarzy

autor http://www.hackwars.pl/vba-excel-automatyczne-tworzenie-arkuszy-o-okreslonej-nazwie/

Worksheets.Count – zwraca liczbę arkuszy w skoroszycie
Sheets.Add(After:=Sheets(Worksheets.Count)) – dodaje nowy arkusz po bieżącym
WS.Name = MonthName(i, True) – zmienia nazwę ustawionego skoroszytu na skrót nazwy kolejnego miesiąca (gdybyśmy chcieli użyć nazwy całego miesiąca zmieniamy wartość True na False)

Opis

tym wpisie przedstawiam jak automatycznie utworzyć 12 arkuszy, których nazwa jest skrótem każdego miesiąca.

Na początku utwórzmy nowy plik Excela z obsługą makr.
Jeśli w pliku znajduje się więcej niż jeden arkusz należy usunąć nadwyżkę:)

Public Sub DodajArkusze()
'deklarowanie zmiennych
Dim i As Integer
Dim WS As Worksheet

i = 1

'rozpoczęcie pętli
For i = 1 To 12

If i > Worksheets.Count Then
'jeśli i jest większa od liczby arkuszy w skoroszycie (pliku) to
'ustawia zmienną WS na nowo dodany arkusz
Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))

Else
'ustawia zmienna WS na pierwszy arkusz z pętli
'tu pętla zagląda tylko za pierwszym razem
Set WS = Sheets(Worksheets.Count)

End If
'zmienia nazwę aktualnie ustawionego arkusza na skrót nazwy miesiąca
WS.Name = MonthName(i, True)

'zwiększa wartość zmiennej i o 1
Next i
End Sub