Historia kursów walut - MAKROAPLIKACJE.PL

Facebook LinkedIn X Pinterest

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.

Spis treści ukryj

1. Tabela krzyżowa

2. Archiwalne pliki NBP

3. Rozwiązanie VBA

3.1. Pobranie pliku z sieci

3.2. Wgranie danych Do arkusza

3.3. Wyliczenie kursów jednostkowych

3.4. Dodanie brakujących dat

4. Rozwiązanie Power Query

4.1. Budowa tabeli zbiorczej

4.2. Obróbka tabeli zbiorczej

4.2.1. Usunięcie zbędnych kolumn

4.2.2. Usunięcie wierszy z błędami

4.2.3. Usunięcie pustych wierszy

4.2.4. Wykrycie typów danych

4.2.5. Edycja daty

4.2.6. „Odpivotowanie” kolumn

4.2.7. Kosmetyka tabeli

4.2.8. Raport w formie „Pivota”

5. Podsumowanie

6. Pliki do pobrania

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.


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

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.


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

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ę.


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

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…


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

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ć.

Pliki do pobrania

Historia kursów walut - vba — rozwiązanie VBA

Historia kursów walut - power query — rozwiązanie Pq

Additional menu

Tabela krzyżowa

Archiwalne pliki NBP

Rozwiązanie VBA

Pobranie pliku z sieci

Wgranie danych Do arkusza

Wyliczenie kursów jednostkowych

Dodanie brakujących dat

Rozwiązanie Power Query

Budowa tabeli zbiorczej

Obróbka tabeli zbiorczej

Usunięcie zbędnych kolumn

Usunięcie wierszy z błędami

Usunięcie pustych wierszy

Wykrycie typów danych

Edycja daty

„Odpivotowanie” kolumn

Kosmetyka tabeli

Raport w formie „Pivota”

Podsumowanie

Pliki do pobrania

Footer