Wyciąganie danych z sieci Web

pytanie zadane 20 lipca 2022 w Visual Basic przez arkopolo Początkujący (250 p.)

Jestem zainteresowany wyciągnięciem danych dot. notowań funduszy PPK z jednej z dwóch podanych stron (bardziej interesowałaby mnie pierwsza opcja):

W przypadku pierwszej opcji nie wiem jak tego mogę dokonać. W przypadku drugiej opcji napotykam na problem w przypadku pobierania danych do Excela poprzez Dane -> Z sieci Web. Próbuję tego dokonać poprzez wejście w archiwum notowań danego funduszu, np. TEN. Archiwum to jest jednak zlokalizowane na wielu podstronach, w opisanej opcji mogę pobierać (ten sposób umożliwia też późniejsze odświeżenie danych) pojedyncze strony. Chciałbym natomiast, aby automatycznie pobierać całą historię notowań dla danego funduszu ze wszystkich podstron. Czytałem trochę o robieniu pętli makro (tutaj link do wpisu), jednak nie potrafię tego rozgryźć (moja strona jest chyba nieco inna).

Będę wdzięczny za wskazówkę, próbny kod w VBA, który nakieruje mnie co mam zrobić :)

Pozdrawiam

1 odpowiedź

odpowiedź 20 lipca 2022 przez VBService Ekspert (253,400 p.)
edycja 21 lipca 2022 przez VBService

W podanym przez Ciebie linku, kolejne podstrony różnią się ostatnią cyfrą (przecinek i cyfra)

1 strona: https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI
2 strona: https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI,2
3 strona: https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI,3 itd.

dla strony 1 możesz ustawić https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI,1

więc kod, ze strony (chodzi o linię 13)

Czytałem trochę o robieniu pętli makro (tutaj link do wpisu)

Sub ImportStronWeb()
'
' ImportStronWeb Makro
'
 
'
 
Dim intLicznik As Long
intlicznikpodstron = 1 'np 8 podstron
intLicznikWierszy = 1 'np kolejne dane w odstępie 500 wierszy
 
Do While intlicznikpodstron < 8
    With ActiveSheet.QueryTables.Add(Connection:="URL;https://tomaszkenig.pl/page/" & intlicznikpodstron & "/", _
    ' reszta kodu

zamień np. tak

Sub ImportStronWeb()
'
' ImportStronWeb Makro
'
 
'
 
Dim intLicznik As Long
intlicznikpodstron = 1 'np 8 podstron
intLicznikWierszy = 1 'np kolejne dane w odstępie 500 wierszy
 
Do While intlicznikpodstron < 8
    With ActiveSheet.QueryTables.Add(Connection:="URL;https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI," & intlicznikpodstron, _
    ' reszta kodu

oczywiście wartości dla zmiennych: intlicznikpodstron, intLicznikWierszy ustaw według własnych potrzeb.

komentarz 21 lipca 2022 przez arkopolo Początkujący (250 p.)

Zrobiłem jak pisałeś i faktycznie pobiera się, aczkolwiek zamiast zwykłych wartości liczbowych w przypadku kursu mam daty (jak zmienię format to po prostu zamienia daty na liczby, ale wciąż to nie te same wartości co na stronie).

Jeszcze pytanie, jeśli chciałbym pobierać wiele takich danych dla różnych funduszy (warunek: dane z nowego funduszu pobierane są w osobnej kolumnie) to muszę tworzyć osobne makro dla każdego czy można je jakoś pogrupować?

komentarz 22 lipca 2022 przez VBService Ekspert (253,400 p.)
edycja 22 lipca 2022 przez VBService

Przy pomocy pętli np. FOR możesz też kontrolować do której kolumny zostanie wgrana następna strona z linku

przykład

Option Explicit
Option Base 1

Sub test()
    Dim intPage As Integer
    Dim arrColumn() As Variant
        arrColumn = Array("A", "C", "E", "G", "I", "K", "M") ' Co druga kolumna
        
    ActiveWindow.ScrollRow = 24 ' Przewiń widok do 24 wiersza
        
    For intPage = 1 To UBound(arrColumn)
        With ActiveSheet.QueryTables.Add(Connection:="URL;https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI," & intPage, _
            Destination:=Range("$" & arrColumn(intPage) & "$1"))
            .Name = "arkopolo"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        
        DoEvents ' Widać jak kolejne kolumny się wczytują
    Next [intPage] ' For intPage = 1 To UBound(arrColumn)
    
    
    Range("A1:A10").EntireRow.Delete
    
    Dim strFundName_Line1, strFundName_Line2 As String
    
    strFundName_Line1 = Range("A1").Value
    strFundName_Line2 = Range("A2").Value
    
    Range("A1:A12").EntireRow.Delete
    Range("A1:A3").EntireRow.Insert
    
    Range("A1").Value = strFundName_Line1
    Range("A2").Value = strFundName_Line2
    
    Range("A56:" & arrColumn(UBound(arrColumn)) & Rows.Count).ClearContents
    ActiveWindow.ScrollRow = 1
End Sub

[ Clear content from a certain cell to the end of the document VBA ]
[ Scroll to specific row VBA ]

komentarz 24 lipca 2022 przez arkopolo Początkujący (250 p.)

Dzięki! Niemniej cały czas nie wiem dlaczego u mnie zamiast kursów pokazują się daty (jak w poprzednim poście), jakieś pomysły? Ponadto, jakiej funkcji użyć, aby ponowne uruchomienie makro nadpisało poprzednie wartości w tym samym miejscu (dodając np. kilka nowych wierszy)? I jeszcze jedno pytanie, czy jest możliwość wrzucenia kilku funduszy do jednego makro, aby notowania każdego z nich pojawiały się w osobnych kolumnach? (teoretycznie mogę zrobić jw. dla pojedynczych funduszy, niemniej wtedy będę miał 100+ makr w arkuszu...)

komentarz 24 lipca 2022 przez VBService Ekspert (253,400 p.)

W sprawie

u mnie zamiast kursów pokazują się daty

spróbuj może tak, w arkuszu, w którym masz zapisane makro

kliknij w komórkę A1 lewym myszki

teraz na klawiaturze przyciśnij kombinację LEWY CTRl + A powinno zaznaczyć wszystkie komórki w arkuszu (arkusz musi być pusty jak na obrazku)

teraz sprawdź, czy masz ustawione w: Narzędzia główne => Liczba ustawioną wartość:

Ogólne (jak na obrazku) lub Automatycznie (zależy od wersji)

komentarz 24 lipca 2022 przez VBService Ekspert (253,400 p.)
edycja 24 lipca 2022 przez VBService

jakiej funkcji użyć, aby ponowne uruchomienie makro nadpisało poprzednie wartości w tym samym miejscu

spróbuj z "wyczyszczeniem" całego arkusza np. tak

ActiveWindow.ScrollRow = 1
Range("A1:Z" & Rows.Count).ClearContents

przed ponownym wczytaniem danych, czyli

Option Explicit
Option Base 1
 
Sub test()
    Dim intPage As Integer
    Dim arrColumn() As Variant
        arrColumn = Array("A", "C", "E", "G", "I", "K", "M") ' Co druga kolumna
        
    ActiveWindow.ScrollRow = 1
    Range("A1:Z" & Rows.Count).ClearContents

    ActiveWindow.ScrollRow = 24 ' Przewiń widok do 24 wiersza
         
    For intPage = 1 To UBound(arrColumn)

    ' reszta kodu

[ Clear content from a certain cell to the end of the document VBA ]

komentarz 24 lipca 2022 przez VBService Ekspert (253,400 p.)
edycja 24 lipca 2022 przez VBService

I jeszcze jedno pytanie, czy jest możliwość wrzucenia kilku funduszy do jednego makro, aby notowania każdego z nich pojawiały się w osobnych kolumnach?

Tak można to zrobić jednym makrem, np. dodając kolejną pętlę, która będzie wczytywała link do kolejnego funduszu.

Coś np. w takim zapisie

Option Explicit
Option Base 1
 
Sub test()
    Dim intPage, intUrl As Integer
    Dim arrColumn(), arrFundUrl() As Variant
    
        arrFundUrl = Array( _
           "https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI", _
           "https://www.biznesradar.pl/notowania-historyczne/ALLP25.TFI" _
        )
        
        arrColumn = Array("A", "C", "E", "G", "I", "K", "M") ' Co druga kolumna
        
    Range("A1:Z" & Rows.Count).ClearContents
    ActiveWindow.ScrollRow = 1
         
    ActiveWindow.ScrollRow = 24 ' Przewiń widok do 24 wiersza
         
    For intUrl = 1 To UBound(arrFundUrl)
        For intPage = 1 To UBound(arrColumn)
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & arrFundUrl(intUrl) & "," & intPage, _
                Destination:=Range("$" & arrColumn(intPage) & "$1"))
            ' tu porzedni kod
            End With
         
            DoEvents ' Widać jak kolejne kolumny się wczytują
        Next [intPage]
    Next [intUrl]
     
    ' tu poprzedni kod
End Sub

tyle, że trzeba by było dodać obliczanie kolejnego wolnego wiersza, ten ostatni "$1"

Destination:=Range("$" & arrColumn(intPage) & "$1"))

no i w tej części kodu wartości dla Range też trzeba by było przeliczać

    Range("A1:A10").EntireRow.Delete
     
    Dim strFundName_Line1, strFundName_Line2 As String
     
    strFundName_Line1 = Range("A1").Value
    strFundName_Line2 = Range("A2").Value
     
    Range("A1:A12").EntireRow.Delete
    Range("A1:A3").EntireRow.Insert
     
    Range("A1").Value = strFundName_Line1
    Range("A2").Value = strFundName_Line2
     
    Range("A56:" & arrColumn(UBound(arrColumn)) & Rows.Count).ClearContents
    ActiveWindow.ScrollRow = 1

żeby powstało coś na wzór (jeśli Ciebie dobrze rozumiem)

* dla celów demonstracyjnych skróciłem wiersze danych do 3 linii na fundusz

komentarz 24 lipca 2022 przez arkopolo Początkujący (250 p.)

Punkt 1: Mam ogólne, ale niestety nie działa i tak :(

Punkt 2: Wpiąłem ten wiersz do swojego kodu i działa (odświeża i nadpisuje poprzednie wartości).

Punkt 3: Tutaj chodzi mi o coś innego. Mianowicie, aby poszczególne fundusze pobierały się do nowych kolumn, nie wierszy. Czyli Fundusz A pobiera się do kolumn A:B (data i kurs), fundusz B pobiera się do kolumn C:D (data i kurs), itd. - Idealnie byłoby, aby nowe strony wczytywały się bez przerw, tj. w jednym ciągu, ale chyba takiej opcji nie ma, gdyż nowa strona musi wczytać się w całości...

Podrzucam aktualny kod u mnie.

Dzięki raz jeszcze !

Mógłbym podrzucić plik xls z prośbą o zobaczenie czy problem w postaci zamiany kursów na daty pojawia się wyłącznie u mnie, ale to mógłbym mailem podesłać, ewentualnie udostępnić na Drive Google.

Sub ImportStronWeb()
'
' ImportStronWeb Makro
'
 
'
 
Dim intLicznik As Long
intlicznikpodstron = 1 'np 8 podstron
intLicznikWierszy = 1 'np kolejne dane w odstępie 500 wierszy

ActiveWindow.ScrollRow = 1
Range("A1:Z" & Rows.Count).ClearContents
 
Do While intlicznikpodstron < 30
    With ActiveSheet.QueryTables.Add(Connection:="URL;https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI," & intlicznikpodstron, _
        Destination:=Range("A" & intLicznikWierszy))
       ' .CommandType = 0
        .Name = "arkopolo"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
intlicznikpodstron = intlicznikpodstron + 1
intLicznikWierszy = intLicznikWierszy + 500
Loop
End Sub

komentarz 26 lipca 2022 przez arkopolo Początkujący (250 p.)

Może ktoś jednak potrafi zaradzić chociaż pkt.1 (bez pkt. 3 obędę się)? Już naprawdę nie wiem co robić, otwieram nowe arkusze i nic. Wrzucałem kod na innym komputerze/innej wersji Excela i też nic. Automatycznie tak jakby z pierwszej kolumny daty format przechodzi na kolejną kolumnę i kursy są w formie daty, a nie wartości...

komentarz 26 lipca 2022 przez VBService Ekspert (253,400 p.)

Mógłbym podrzucić plik xls z prośbą o zobaczenie czy problem w postaci zamiany kursów na daty pojawia się wyłącznie u mnie, ale to mógłbym mailem podesłać, ewentualnie udostępnić na Drive Google.

Wrzuć plik na np. google drive i wstaw, proszę linka.

komentarz 27 lipca 2022 przez arkopolo Początkujący (250 p.)

LINK do pliku xlsm, czy jednak w takiej formie można wejść w makro/VBA?

komentarz 27 lipca 2022 przez VBService Ekspert (253,400 p.)

Pobrałem plik i uruchomiłem na Mojej wersji Excel-a

nie ma tego problemu z datą w kolumnie.

Może zrób: Repair an Office application

komentarz 27 lipca 2022 przez arkopolo Początkujący (250 p.)
edycja 27 lipca 2022 przez arkopolo

Zrobiona naprawa, nawet ponownie zainstalowałem Office'a i cały czas ten sam problem... W ogóle, czy zmieniałeś kod u siebie, bo u mnie wyświetla się wszystko w 2 kolumnach?

Co ciekawe, gdy kurs wynosi dokładnie 10.0, wówczas wyświetla się poprawnie... Kompletne czary mary. Na YT nie znalazłem niczego na ten temat, chyba nikt się jeszcze nie borykał z tym.

P.S. Jeśli to by coś dało i było możliwe, to mógłbym jeszcze pobierać dane z tej strony (przykład) - https://www.analizy.pl/fundusze-ppk/PIO70/pekao-ppk-2020-spokojne-jutro. Niemniej tam nie mamy wprost danych historycznych, trzeba byłoby je jakoś "wyczytać" z wykresu (to już pewnie zabawa na scrapowanie w jakimś R itp).

komentarz 28 lipca 2022 przez VBService Ekspert (253,400 p.)

Użyłem Twój plik excel-a i Twój kod zamieniłem na ten kod

Option Explicit
Option Base 1
 
Sub test()
    Dim intPage As Integer
    Dim arrColumn() As Variant
        arrColumn = Array("A", "C", "E", "G", "I", "K", "M") ' Co druga kolumna

    ActiveWindow.ScrollRow = 1
    Range("A1:Z" & Rows.Count).ClearContents
         
    ActiveWindow.ScrollRow = 24 ' Przewiń widok do 24 wiersza
         
    For intPage = 1 To UBound(arrColumn)
        With ActiveSheet.QueryTables.Add(Connection:="URL;https://www.biznesradar.pl/notowania-historyczne/NNDN25.TFI," & intPage, _
            Destination:=Range("$" & arrColumn(intPage) & "$1"))
            .Name = "arkopolo"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
         
        DoEvents ' Widać jak kolejne kolumny się wczytują
    Next [intPage] ' For intPage = 1 To UBound(arrColumn)
     
     
    Range("A1:A10").EntireRow.Delete
     
    Dim strFundName_Line1, strFundName_Line2 As String
     
    strFundName_Line1 = Range("A1").Value
    strFundName_Line2 = Range("A2").Value
     
    Range("A1:A12").EntireRow.Delete
    Range("A1:A3").EntireRow.Insert
     
    Range("A1").Value = strFundName_Line1
    Range("A2").Value = strFundName_Line2
     
    Range("A56:" & arrColumn(UBound(arrColumn)) & Rows.Count).ClearContents
    ActiveWindow.ScrollRow = 1
End Sub

użyłem Office 64bit 2016 Pro plus pl, może to jest problem z wersją jaką używasz.

komentarz 28 lipca 2022 przez arkopolo Początkujący (250 p.)

Ja używam Office 64bit 2019 Pro Plus PL, więc jest nieco nowsza wersja. Ale chyba nie powinno być problemów przy nowszej wersji. Ona też nie jest znowu taka nowa, żeby były to jakieś problemy "niemowlęce". Musiałbym kupić inną/starszą wersję żeby przetestować...

A to pobieranie z tego drugiego linku to jak domyślam się odpada tym sposobem, nie?

komentarz 29 lipca 2022 przez arkopolo Początkujący (250 p.)

Eureka! Udało mi się obejść problem! Mam w związku z tym ostatnie pytanie, czy jest możliwość wrzucenia w jedno makro kilku funduszy, aby zaciągały się w osobnych kolumnach?

Np. Fundusz 1 zajmuje kolumny A:B (data, kurs), fundusz 2 C:D (data kurs)... itd.

komentarz 29 lipca 2022 przez VBService Ekspert (253,400 p.)

Tak, można wrzucić w jedno makro.

komentarz 29 lipca 2022 przez arkopolo Początkujący (250 p.)

Mógłbyś wskazać mi jakiej zmiany w kodzie muszę dokonać, aby wrzucić kolejny fundusz (może być kolejny fundusz z TEGO linku)? Resztę już potem dłubałbym sobie po swojemu (mam nadzieję, że podołam)