Pobranie aktualnych kursów walut jest zadaniem, które pojawia się często w tutorialach Excela. Zwykle chodzi o rozwiązanie dynamiczne, które odświeży wyniki po kliknięciu w przycisk. Wyzwaniem większego kalibru jest utworzenie tabeli z danymi archiwalnymi – ot taka, historia kursów walut aktualizowana na bieżąco. Z taką potrzebą spotkałem się w 2019r. tworząc aplikację dla HR. W tym artykule opiszę, jak to zadanie wykonać – zarówno za pomocą VBA, jak i Power Query.
Tabela krzyżowa
W przypadku wspomnianego projektu, stworzenie tabeli z historią kursów walut, było częścią większej całości. Jej znaczenie było jednak kluczowe z punktu widzenia prawidłowego rozliczania delegacji zagranicznych. Po wybraniu waluty i wpisaniu kosztu, kwota miała się przewalutować po odpowiednim kursie.
Uznałem także, że końcowy raport powinien być w formie tabeli krzyżowej, a nie bazodanowej. W pierwszej kolumnie chciałem mieć datę, zaś w pierwszym wierszu – symbole walut. Na przecięciu wiersza i kolumny miał się znaleźć kurs jednostkowy.
NBP w niektórych przypadkach podaje kurs za 100 lub 10 000 jednostek. Aby uprościć temat, potrzebujemy kurów jednostkowych dla wszystkich walut.
Efekt końcowy miał wyglądać tak, jak na obrazku poniżej.
Dlaczego jednak tabela krzyżowa? Powody były dwa.
Po pierwsze, taka tabela rezerwuje tylko jeden wiersz dla dnia. W układzie bazodanowym mielibyśmy ich aż trzydzieści pięć (tyle jest walut). Była więc to dla mnie gwarancja, że zrobienie tego w Excelu jest bezpieczne. Wierszy wystarczy nam na ponad sto lat!
Po drugie, odczyt kursu z takiej tabeli jest wygodniejszy. Możemy użyć funkcji INDEKS i zagnieździć w niej dwukrotnie PODAJ.POZYCJĘ. Szukanie wartości na podstawie dwóch zmiennych jest w Excelu trudniejsze.
Archiwalne pliki NBP
Wróćmy teraz do naszego zadania… Naszym celem będzie stworzenie tabeli archiwalnej kursów. Począwszy od 1-stycznia 2020r. – aż po dzień bieżący.
W obu rozwiązaniach będziemy bazować na tym, że NBP zamieszcza na swojej stronie pliki CSV i XLS z historią kursów średnich za dany rok.
W rozwiązaniu VBA, będziemy pobierać na dysk plik XLS z kursami za bieżący rok. Następnie będziemy „doklejać” brakujące daty do już istniejącej tabelki.
W rozwiązaniu PQ nie będziemy niczego pobierać, a jedynie łączyć się z plikami CSV. Skonsolidujemy te dane w nowym zapytaniu i będziemy je tylko odświeżać.
Rozwiązanie VBA
Przyjrzyjmy się najpierw rozwiązaniu, które jest oparte w całości na kodzie VBA. Bez dwóch zdań jest to rozwiązanie bardziej skomplikowane, ale wbrew pozorom – nieco szybsze. Nie tworzy też łączy.
Pobranie pliku z sieci
VBA nie oferuje niestety prostego sposobu na pobranie pliku z internetu. Proponuję ściągnąć gotowy kod z sieci i podmienić dwie rzeczy: adres URL pliku XLS i docelową ścieżkę na dysku dla niego.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
Public Sub PobierzPlikNBP() Dim oStream As Object Dim myURL As String Dim oWinHttpReq As Object On Error GoTo ObslugaBledu 'Pobierz pełny adres strony, połącz się myURL = gsURL_KURSY Set oWinHttpReq = CreateObject("Microsoft.XMLHTTP") oWinHttpReq.Open "GET", myURL, False, "username", "password" oWinHttpReq.send 'Ściągnij plik If oWinHttpReq.Status = 200 Then Set oStream = CreateObject("ADODB.Stream") oStream.Open oStream.Type = 1 oStream.Write oWinHttpReq.responseBody oStream.SaveToFile gsZAPIS_XLS, 2 '1 = no overwrite, 2 = overwrite oStream.Close End If Wyjscie: Set oStream = Nothing Set oWinHttpReq = Nothing On Error GoTo 0 Exit Sub ObslugaBledu: MsgBox Title:="Błąd programu!", Buttons:=vbInformation, _ Prompt:="Informacje dotyczące błędu: " & vbCr & vbCr & _ "Numer: " & vbTab & Err.Number & vbCr & _ "Opis: " & vbTab & Err.Description GoTo Wyjscie End Sub |
Warto zauważyć, że obie wartości zaszyłem w stałych globalnych.
Oznacza to, że na początku każdego roku kalendarzowego musimy podmienić liczbę w stałej gsURL_KURSY. Chodzi o to, aby program pobierał plik XLS dla roku bieżącego, a nie poprzedniego.
Oczywiście możemy to zautomatyzować. Wyciągamy rok z dzisiejszej daty i cały adres URL zapisujemy w zmiennej. Warto jednak zostawić rozwiązanie ze stałą. Dzięki niej, mamy gotowca, który pozwala nam pobrać dowolny plik z sieci.
Wgranie danych Do arkusza
Mamy już na dysku plik XLS, pobrany ze strony NBP.
Po otwarciu, wygląda on w ten sposób..
Warto teraz otworzyć go makrem i zgrać dane (ale nie metodą Kopiuj-Wklej) do arkusza pomocniczego w naszym pliku z historią kursów walut. Będzie nam wygodniej obrabiać te dane później.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
Public Sub ZgrajDaneNBPDoArkusza() Dim wkbNbp As Workbook ' Skoroszyt XLS pobrany ze strony NBP Dim wksNbp As Worksheet ' Arkusz nr 1 z kursami Dim lNbpOst As Long ' Ostatni wiersz Dim lNbpKol As Long 'Liczba kolumn Dim avNbp As Variant ' Tablica średnich kursów On Error GoTo ObslugaBledu 'Otwórz XLS i wgraj cały obszar danych do tablicy Set wkbNbp = Workbooks.Open( _ Filename:=gsZAPIS_XLS, UpdateLinks:=False, ReadOnly:=True) Set wksNbp = wkbNbp.Worksheets(1) lNbpOst = wksNbp.Range("A" & wksNbp.Rows.Count).End(xlUp).Row lNbpKol = wksNbp.Cells(1, wksNbp.Columns.Count).End(xlToLeft).Column avNbp = wksNbp.Range("A1").Resize(lNbpOst, lNbpKol) 'Wgraj aktualne dane With wksKopia .UsedRange.ClearContents .Range("A1").Resize(lNbpOst, lNbpKol).Value = avNbp End With wkbNbp.Close SaveChanges:=False Wyjscie: Set wkbNbp = Nothing Set wksNbp = Nothing On Error GoTo 0 Exit Sub ObslugaBledu: MsgBox Title:="Błąd programu!", Buttons:=vbInformation, _ Prompt:="Informacje dotyczące błędu: " & vbCr & vbCr & _ "Numer: " & vbTab & Err.Number & vbCr & _ "Opis: " & vbTab & Err.Description GoTo Wyjscie End Sub |
Wyliczenie kursów jednostkowych
Jak wspomniałem, dla niektórych walut, NBP pokazuje kurs dla 100 jednostek. Pierwszym celem naszej obróbki, będzie więc wyciągniecie kursów jednostkowych.
Z pomocą przychodzi nam ostatni wiersz, który przechowuje tą informację.
Jak najprościej wyliczyć kursy jednostkowe?
Możemy przejść w pętli po każdej komórce z liczbą jednostek. Jeśli natrafimy na wartość > 1, wtedy każdą komórkę liczbową z tej kolumny podzielimy przez liczbę jednostek. Nie jest to rozwiązanie w 100% optymalne, ale cała operacja i tak zajmie nam niecałą sekundę.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
Public Sub ObliczKursyJednostkowe() ' Makro dzieli przez 100 lub 10000 niektóre waluty. Chcemy mieć kurs jednostkowy. Dim lKopiaOst As Long ' Ostatni wiersz w wksKopia Dim iKolumny As Integer ' Liczba kolumn (bazujemy na ostatnim wierszu) Dim sKodWaluty As String ' Kod ISO waluty Dim iLiczbaJednostek As Integer ' Liczba jednostek Dim rngKursyWaluty As Range ' Kolumna z kursami danej waluty Dim rngKursWaluty As Range ' Pojedynczy kurs Dim x As Long ' Licznik pętli On Error GoTo ObslugaBledu 'Sprawdź ile mamy walut With wksKopia lKopiaOst = .Range("A" & .Rows.Count).End(xlUp).Row iKolumny = WorksheetFunction.CountA(.Rows(lKopiaOst)) End With 'Przejdź w pętli po każdej kolumnie i podziel kursy jeśli trzeba For x = 2 To iKolumny 'Zaczytaj kod waluty i liczbę jednostek With wksKopia iLiczbaJednostek = .Cells(lKopiaOst, x).Value sKodWaluty = Trim(.Cells(lKopiaOst - 2, x).Value) End With 'Działaj gdy liczba jednostek > 1 If iLiczbaJednostek > 1 Then With wksKopia 'Zaktualizuj wpis w wierszu nr 1 .Cells(1, x) = "1 " & sKodWaluty 'Ustal zakres kursów dla tej waluty Set rngKursyWaluty = .Cells(3, x).Resize(lKopiaOst - 6, 1) 'Podziel każdy kurs przez liczbę jednostek For Each rngKursWaluty In rngKursyWaluty.Cells rngKursWaluty = rngKursWaluty / iLiczbaJednostek Next rngKursWaluty End With ' With wksKopia End If ' If iLiczbaJednostek > 1 Then Next x ' For x = 2 To iKolumny - 1 Wyjscie: Set rngKursyWaluty = Nothing Set rngKursWaluty = Nothing On Error GoTo 0 Exit Sub ObslugaBledu: MsgBox Title:="Błąd programu!", Buttons:=vbInformation, _ Prompt:="Informacje dotyczące błędu: " & vbCr & vbCr & _ "Numer: " & vbTab & Err.Number & vbCr & _ "Opis: " & vbTab & Err.Description GoTo Wyjscie End Sub |
Na przykładzie kilku walut z liczbą jednostek >1, widać, że efekt został osiągnięty. Mamy tam bardzo małe kwoty – kursy jednostkowe.
Dodanie brakujących dat
Ostatnia rzeczą, którą musimy zrobić jest dodanie brakujących kursów z arkusza KOPIA (powielone dane z XLS) do arkusza HISTORIA KURSÓW.
W tym celu możemy pobrać do tablicy wszystkie daty z arkusza KOPIA. Następnie przejść w pętli po każdej dacie i sprawdzić, czy znajduje się ona w arkuszu HISTORIA KURSÓW. Jeśli jej tam nie ma – dodać ją.
Jeśli program znajdzie przynajmniej jedną nową datę – musimy wstawić jeszcze formułę R1C1. Zaczyta nam ona kurs jednostkowy na podstawie dwóch zmiennych: daty i symbolu waluty…
Oto przykład. Aktualny plik z historią nie zawiera jeszcze danych za listopad…
Po uruchomieniu makra – brakujące daty (wraz z kursami) zostały dodane.
Kod, który realizuje to zadanie może wyglądać tak…
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
Public Sub DodajNoweKursyDoHistorii() 'Makro biegnie w pętli po wszystkich datach w kolumnie A arkusza wksKopia. 'Dodaje do wksHistoria daty, których tam nie ma, a potem wstawia formułę z kursami. Dim lHistoriaOst As Long 'Ostatni wiersz w wksHistoria Dim lKopiaOst As Long 'Ostatni wiersz w wksKopia Dim avSzukaneDaty As Variant 'Tablica szukanych dat Dim lSzukanaData As Long 'Data, którą szukamy w wksHistoria Dim lPozycjaDaty As Long 'Pozycja szukanej daty Dim iLicznik As Integer 'Licznik brakujących dat Dim x As Long 'Licznik pętli On Error GoTo ObslugaBledu 'Sprawdź ostatnie wiersze lHistoriaOst = wksHistoria.Range("A" & wksHistoria.Rows.Count).End(xlUp).Row lKopiaOst = wksKopia.Range("A" & wksKopia.Rows.Count).End(xlUp).Row - 4 'Pobierz do tablicy szukane daty avSzukaneDaty = WorksheetFunction.Transpose(wksKopia.Range("A3:A" & lKopiaOst)) 'Sprawdź pozycję każdej daty For x = LBound(avSzukaneDaty) To UBound(avSzukaneDaty) 'Pobierz szukaną datę lSzukanaData = avSzukaneDaty(x) 'Sprawdź czy istnieje w wksHistoria On Error Resume Next lPozycjaDaty = 0 lPozycjaDaty = WorksheetFunction.Match(lSzukanaData, wksHistoria.Range("A:A"), 0) On Error GoTo ObslugaBledu 'Dodaj datę do historii jeśli jej nie ma If lPozycjaDaty = 0 Then 'Zwiększ licznik iLicznik = iLicznik + 1 'Dodaj ją do historii wksHistoria.Cells(lHistoriaOst, "A").Offset(iLicznik, 0) = lSzukanaData End If ' If lPozycjaDaty = 0 Then Next x ' For x = LBound(avSzukaneDaty) To UBound(avSzukaneDaty) 'Dodaj formułę zaczytającą kursy jesli są nowe daty If iLicznik <> 0 Then With wksHistoria.Cells(lHistoriaOst, "B").Offset(1, 0).Resize(iLicznik, 35) .FormulaR1C1 = "=IFERROR(INDEX(KOPIA!R1C1:R99999C38,MATCH(RC1,KOPIA!R1C1:R99999C1,0),MATCH(R1C,KOPIA!R1,0)),""-----"")" .Value = .Value End With End If Wyjscie: On Error GoTo 0 Exit Sub ObslugaBledu: MsgBox Title:="Błąd programu!", Buttons:=vbInformation, _ Prompt:="Informacje dotyczące błędu: " & vbCr & vbCr & _ "Numer: " & vbTab & Err.Number & vbCr & _ "Opis: " & vbTab & Err.Description GoTo Wyjscie End Sub |
Rozwiązanie Power Query
Aby stworzyć gotowe rozwiązanie w VBA, musieliśmy się trochę napocić. W Power Query to zadanie jest dość łatwe do wykonania.
Budowa tabeli zbiorczej
Pierwszą rzeczą, którą musimy zrobić jest odwiedzenie strony NBP z archiwalnymi kursami walut. Tym razem nie będzie nas interesować pojedynczy plik XLS, a pliki CSV za lata 2020, 2021, 2022 (bieżący rok).
Dobra wiadomość jest taka, że nie musimy pobierać tych plików na dysk – wystarczy skopiować odnośnik do każdego z nich i utworzyć osobne połączenia w PQ.
Uzyskamy efekt podobny do tego poniżej…
Aby utworzyć jedną tabelę zbiorczą na bazie tych trzech zapytań, należy skorzystać z opcji Dołączanie i wybrać wszystkie trzy tabele.
Uzyskamy w wyniku skonsolidowaną tabelę do dalszej obróbki…
Obróbka tabeli zbiorczej
Prześledźmy teraz każdy z zastosowanych kroków…
Usunięcie zbędnych kolumn
Najpierw usunąłem trzy kolumny z końca tabeli – nie będą nam już potrzebne.
Usunięcie wierszy z błędami
Następnie skasowałem wszystkie błędne wiersze z kolumny data. Dzięki temu pozbyłem się m.in. wierszy z symbolem i liczbą jednostkową.
Usunięcie pustych wierszy
Następnie skasowałem wszystkie puste wiersze. Musiałem to zrobić poprzez odfiltrowanie wartości null, ponieważ opcja Usuń puste wiersze nie zadziała w naszym przypadku. Usunie ona wiersz, gdy wszystkie kolumny wiersza będą puste.
Wykrycie typów danych
Mając już tabelę oczyszczoną ze „śmieci”, mogłem się zająć jej edycją.
Najpierw zaznaczyłem wszystkie kolumny (oprócz pierwszej z datą) i kliknąłem na karcie Przekształć opcję Wykryj typ danych. Automatycznie zamieniło mi to kursy z wartości tekstowych na liczby dziesiętne. O to chodziło!
Edycja daty
Datę w postaci RRRRMMDD nie udało mi się przerobić za pomocą ustawień regionalnych. Użyłem więc popularnego pioruna, czyli opcji Kolumna z przykładów.
Następnie usunąłem kolumnę pierwotną i w jej miejsce wstawiłem tą poprawioną.
„Odpivotowanie” kolumn
Pozostał jeszcze jeden ważny problem do rozwiązania – wyliczenie kursów jednostkowych. Jednostki były od teraz dostępne tylko w nagłówkach. Uznałem więc, że dobrze byłoby przekształcić tą tabelkę do układu bazodanowego…
A następnie oddzielić liczbę jednostek od symbolu waluty…
Teraz już wystarczyło tylko podzielić kolumnę z wartością, przez pole z liczbą jednostek… Ostatnia kolumna pokazuje kurs jednostkowy.
Kosmetyka tabeli
Usunąłem zbędne kolumny, zmieniłem nazwy dla kolumn i w efekcie uzyskałem kompletną tabelę… ale w układzie bazodanowym, a nie krzyżowym.
Raport w formie „Pivota”
Rozwiązaniem tego problemu było zapisanie raportu, nie w zwykłej formie lecz w postaci tabeli przestawnej. Dzięki temu uzyskałem wygodny układ, który mogłem wykorzystać do dalszej pracy.
Ponieważ jednej walucie jest przypisany tylko jeden kurs dla dnia, możemy wybrać dowolną operację matematyczną – ja wybrałem średnią.
Podsumowanie
Jak widać, zadanie to możemy wykonać zarówno dzięki VBA, jak i Power Query.
Pomimo tego, że uwielbiam VBA za ogromną elastyczność, to tym razem muszę jednoznacznie przyznać, że zadanie to dużo łatwiej zrobić, wyklikując poszczególne kroki w Power Query.
Jeżeli chodzi o szybkość działania to w przypadku VBA całość odbywa się u mnie w ciągu niecałej sekundy.
Gdy usunę wszystkie dane za rok 2022, wynik praktycznie się nie zmienia.
W przypadku Power Query te wartości są bardzo zbliżone.
Zauważyłem, że odświeżenie trwa nieco dłużej w momencie otwarcia pliku. Ale nie wysuwałbym tu pochopnych wniosków.
Istnieją dwie istotne rzeczy, które dotyczą rozwiązania wg Power Query.
Po pierwsze, z początkiem nowego roku kalendarzowego, będziemy musieli dodać nowe zapytanie (połączenie) i umieścić je w tabeli zbiorczej.
Po drugie, musimy koniecznie odznaczyć opcję Włącz odświeżanie w tle.
Wynika to z faktu, że kod VBA powinien się zatrzymać na czas odświeżania kwerendy. W przeciwnym razie istnieje ryzyko, że będziemy bazować na nieaktualnych danych – makro wykona się, a kwerenda będzie się jeszcze odświeżać.