Güncel Tablo Çekme

ua_mstf · 25 Mart 2023

Herkese kolay gelsin. https://www.kap.org.tr/tr/Endeksler linkte bulunan tabloları web'den veri şeklinde alamıyorum. Linkteki tablolar zaman zaman değişebiliyor. Dosyayı her açtığımda tabloların güncel halinin verisi siteden alınsın istiyorum ama beceremedim yardımlarınızı bekliyorum.

Haluk · 25 Mart 2023

C#:

Sub Test()
'   Haluk - 25/03/2023

    Dim HTTP As Object, HTML As Object, i As Integer, j As Integer
    Dim myURL As String
    
    Range("A1:C" & Rows.Count) = ""
    
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    
    myURL = "https://www.kap.org.tr/tr/Endeksler"
    
    HTTP.Open "GET", myURL, False
    HTTP.send
    
    HTML.body.innerHTML = HTTP.responseText
    Set objCollection = HTML.getElementsByTagName("div")
    
    For i = 0 To objCollection.Length - 1
        If objCollection(i).ClassName = "vcell" Then
            j = j + 1
            Range("A" & j) = objCollection(i).innerText
            GoTo resumeFor:
        End If
        If objCollection(i).ClassName = "comp-cell _01 vtable" Then
            j = j + 1
            Range("A" & j) = objCollection(i).innerText
        ElseIf objCollection(i).ClassName = "comp-cell _02 vtable" Then
            Range("B" & j) = objCollection(i).innerText
        ElseIf objCollection(i).ClassName = "comp-cell _03 vtable" Then
            Range("C" & j) = objCollection(i).innerText
        End If
resumeFor:
    Next
    
    Range("A:A").ColumnWidth = 18
    Range("B:B").ColumnWidth = 10
    Range("C:C").ColumnWidth = 65
    
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

ua_mstf · 26 Mart 2023

Çok işime yaradı. Teşekkür ederim. Tablodaki yazan şirket ünvanları tıklanabilir durum da ünvanları köprü olarak alabilir miyiz excele.

Haluk · 26 Mart 2023

Linkler "B" sütunundaki hücrelere ilave edildi....

Linkleri tıkladığınızda, biraz bekledikten sonra klavyeden "Esc" tuşuna basmanız gerekiyor.

C#:

Sub Test2()
'   Haluk - 26/03/2023

    Dim HTTP As Object, HTML As Object, i As Integer, j As Integer
    Dim myURL As String
    
    Range("A1:C" & Rows.Count) = ""
    
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    
    myURL = "https://www.kap.org.tr/tr/Endeksler"
    
    HTTP.Open "GET", myURL, False
    HTTP.send
    
    HTML.body.innerHTML = HTTP.responseText
    Set objCollection = HTML.getElementsByTagName("div")
    
    For i = 0 To objCollection.Length - 1
        If objCollection(i).ClassName = "vcell" Then
            j = j + 1
            Range("A" & j) = objCollection(i).innerText
        End If
        If objCollection(i).ClassName = "comp-cell _01 vtable" Then
            j = j + 1
            Range("A" & j) = objCollection(i).innerText
        ElseIf objCollection(i).ClassName = "comp-cell _02 vtable" Then
            Range("B" & j) = objCollection(i).innerText
            ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & j), Address:="https://www.kap.org.tr/" & Replace(objCollection(i).getElementsByTagName("a")(0).href, "about:/", "")
        ElseIf objCollection(i).ClassName = "comp-cell _03 vtable" Then
            Range("C" & j) = objCollection(i).innerText
        End If
    Next
    
    Range("A:A").ColumnWidth = 18
    Range("B:B").ColumnWidth = 10
    Range("C:C").ColumnWidth = 65
    
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

ua_mstf · 27 Mart 2023

Youtube da onlarca video izledim hiç biri işe yaramadı siz hallettiniz çok teşekkürler.

Google sheets de . Çalışan şöyle bir formül var.

=IMPORTXML("https://www.kap.org.tr/tr/kfif/4028e4a240f2ef4c014101b18dc000f7";"/html/body/div[7]/div/div/div[3]/div[2]/table/tbody/tr[6]/td[2]/div")

Bu formulü excelde nasıl çalıştıra bilirim acaba ?

https://www.kap.org.tr/tr/kfifAllInfoListByItem/KPY97SummaryGrid

Bu linkide yukardaki kodunuza bakarak uyarlamaya çalıştım excele almak için beceremedim ama.

Haluk · 28 Mart 2023

ua_mstf' Alıntı:
https://www.kap.org.tr/tr/kfifAllInfoListByItem/KPY97SummaryGrid

Bu linkide yukardaki kodunuza bakarak uyarlamaya çalıştım excele almak için beceremedim ama.

C#:

Sub Test2()
'   Haluk - 28/03/2023

    Dim HTTP As Object, HTML As Object, i As Integer, j As Integer, k As Integer
    Dim myURL As String
    
    Range("A1:I" & Rows.Count).Clear
    
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    
    myURL = "https://www.kap.org.tr/tr/kfifAllInfoListByItem/KPY97SummaryGrid"
    
    HTTP.Open "GET", myURL, False
    HTTP.send
    
    HTML.body.innerHTML = HTTP.responseText
    Set objCollection = HTML.getElementsByTagName("a")
    
    For i = 0 To objCollection.Length - 1
        If objCollection(i).ClassName = "w-clearfix w-inline-block a-table-row infoRow" Then
            j = j + 1
            Set Divs = objCollection(i).getElementsByTagName("div")
            For k = 0 To Divs.Length - 1
                temp = Replace(Divs(k).innerText, ".", "")
                Cells(j, k + 1) = Replace(temp, ",", ".")
                If k = 5 Or k = 6 Then Cells(j, k + 1).NumberFormat = "#,##0"
                If k = 8 And j > 1 Then Cells(j, k + 1) = CDate(temp)
            Next
        End If
    Next
        
    Range("A1:I1").Font.Bold = True
    Range("A:A").ColumnWidth = 10
    Range("B:B").ColumnWidth = 40
    Range("C:H").ColumnWidth = 14
    Range("I:I").ColumnWidth = 20
    
    Range("A1:I" & j).Cells.Borders.LineStyle = XlLineStyle.xlContinuous

    
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

Haluk · 28 Mart 2023

@ua_mstf ;

6 No'lu mesajdaki kod işe yaradı mı?

.

ua_mstf · 3 Nisan 2023

Haluk' Alıntı:
@ua_mstf ;

6 No'lu mesajdaki kod işe yaradı mı?

.

Kod da hiç problem yok çalıştı teşekkür ederim. Benim yapmak istediğin şekli olmadı sadece ona uğraşıyordum yapmadan cevap vermeyim size diye.

4 no'lu mesajda yazdığınız kod da köprü eklediğimiz linklere gidip orada bir satırdan veri çekmemiz onu da "D" sütununa yazmamız mümkün müdür?

Fotoğraf bu fotoğrafta 2 ile gösterdiğim yerdeki değer.

Haluk · 3 Nisan 2023

C#:

Sub Test3()
'   Haluk - 03/04/2023

    Dim HTTP As Object, HTML As Object, i As Integer, j As Integer
    Dim myURL As String
    
    Range("A1:D" & Rows.Count).Clear
    
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    
    Set HTML2 = CreateObject("HTMLFILE")
    
    myURL = "https://www.kap.org.tr/tr/Endeksler"
    
    HTTP.Open "GET", myURL, False
    HTTP.send
    
    HTML.body.innerHTML = HTTP.responseText
    Set objCollection = HTML.getElementsByTagName("div")
    
    For i = 0 To objCollection.Length - 1
        If objCollection(i).ClassName = "vcell" Then
            j = j + 1
            Range("A" & j) = objCollection(i).innerText
            If Not IsNumeric(objCollection(i).innerText) Then
                Range("A" & j).Font.Bold = True
                Range("A" & j).Font.Color = vbRed
            End If
        End If
        If objCollection(i).ClassName = "comp-cell _01 vtable" Then
            j = j + 1
            Range("A" & j) = objCollection(i).innerText
        ElseIf objCollection(i).ClassName = "comp-cell _02 vtable" Then
            Range("B" & j) = objCollection(i).innerText
            ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & j), Address:="https://www.kap.org.tr/" & Replace(objCollection(i).getElementsByTagName("a")(0).href, "about:/", "")
            
            If j <= 101 Then
                myURL2 = Replace(Replace(objCollection(i).getElementsByTagName("a")(0).href, "about:/", ""), "tr/sirket-bilgileri/ozet", "")
                myURL2 = "https://www.kap.org.tr/tr/kfif" & myURL2
                
    
                HTTP.Open "GET", myURL2, False
                HTTP.send
                
                HTML2.body.innerHTML = HTTP.responseText
                
                Set myTable = HTML2.getElementsByTagName("table")(1)
                
                If myTable.Rows.Length >= 5 Then
                    Range("D" & j) = myTable.Rows(5).Cells(1).innerText / 100
                    Range("D" & j).NumberFormat = "0.00 %"
                End If
            End If
        ElseIf objCollection(i).ClassName = "comp-cell _03 vtable" Then
            Range("C" & j) = objCollection(i).innerText
        End If
        
        DoEvents
    Next
    
    Range("A:A").ColumnWidth = 18
    Range("B:B").ColumnWidth = 10
    Range("C:C").ColumnWidth = 65
    Range("D:D").ColumnWidth = 9
    
    Range("A1:D" & j).Cells.Borders.LineStyle = XlLineStyle.xlContinuous
    
    MsgBox "Veriler alındı...."
    
    Set HTML2 = Nothing
    Set HTTP2 = Nothing
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

ua_mstf · 4 Nisan 2023

teşekkürler. düzgün çalışıyor fakat sadece ilk grup tablonun verisi var gerisi gelmiyor malesef.

Haluk · 4 Nisan 2023

Sadece BIST-100 şirketlerinin D-sütunundaki verileri yeterli olur diye düşünmüştüm.

Eğer listedeki 3600 küsür şirketin hepsinin D-sütunundaki verilerini alacaksanız o zaman " If j <= 101 Then" satırını ve ona bağlı "End If" satırını silin, tekrar çalıştırın.

Bununla ilgili olarak 9 No'lu mesajda BIST100 firmaları için sunucuya 100 adet ilave istek gönderilirken, tüm firmaların ek bilgisini almak için bu sefer 6300 küsür istek gönderilmek zorunda. Bu da kodun çalışma süresini uzatır tabii....

.

ua_mstf · 4 Nisan 2023

Evet biraz vakit alıyor ama filtrelemek için gerekli biraz . Kod mükemmel oldu her şey çalışıyor sadece filtreleme yapmak için kullanabileceğim bi şey daha eklemek istiyorum.

Endeks gruplarına dahil olan şirketlerinin yanındaki sütunda her grubun adı yazabilir mi ?

fotoğraf şu fotoğraf da olduğu gibi her grubun adı A sütunun da yazacak demek istiyorum.

Haluk · 4 Nisan 2023

11 No'lu mesajda belirtilen revizyonu aşağıdaki kodda yaparsınız;

C#:

Sub Test4()
'   Haluk - 04/04/2023

    Dim HTTP As Object, HTML As Object, i As Integer, j As Integer
    Dim myURL As String
    
    Range("A1:E" & Rows.Count).Clear
    
    Set HTML = CreateObject("HTMLFILE")
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    
    Set HTML2 = CreateObject("HTMLFILE")
    
    myURL = "https://www.kap.org.tr/tr/Endeksler"
    
    HTTP.Open "GET", myURL, False
    HTTP.send
    
    HTML.body.innerHTML = HTTP.responseText
    Set objCollection = HTML.getElementsByTagName("div")
    
    For i = 0 To objCollection.Length - 1
        If objCollection(i).ClassName = "vcell" Then
            j = j + 1
            
            If Not IsNumeric(objCollection(i).innerText) Then
                strHeader = objCollection(i).innerText
                Range("A" & j) = strHeader
                Range("A" & j).Font.Bold = True
                Range("A" & j).Font.Color = vbRed
            Else
                Range("B" & j) = objCollection(i).innerText
            End If
        End If
        
        If objCollection(i).ClassName = "comp-cell _01 vtable" Then
            j = j + 1
            Range("B" & j) = objCollection(i).innerText
            Range("A" & j) = strHeader
        ElseIf objCollection(i).ClassName = "comp-cell _02 vtable" Then
            Range("C" & j) = objCollection(i).innerText
            ActiveSheet.Hyperlinks.Add Anchor:=Range("C" & j), Address:="https://www.kap.org.tr/" & Replace(objCollection(i).getElementsByTagName("a")(0).href, "about:/", "")
            
            If j <= 101 Then
                myURL2 = Replace(Replace(objCollection(i).getElementsByTagName("a")(0).href, "about:/", ""), "tr/sirket-bilgileri/ozet", "")
                myURL2 = "https://www.kap.org.tr/tr/kfif" & myURL2
                
    
                HTTP.Open "GET", myURL2, False
                HTTP.send
                
                HTML2.body.innerHTML = HTTP.responseText
                
                Set myTable = HTML2.getElementsByTagName("table")(1)
                
                If myTable.Rows.Length >= 5 Then
                    Range("E" & j) = myTable.Rows(5).Cells(1).innerText / 100
                    Range("E" & j).NumberFormat = "0.00 %"
                End If
            End If
        ElseIf objCollection(i).ClassName = "comp-cell _03 vtable" Then
            Range("D" & j) = objCollection(i).innerText
        End If
        
        DoEvents
    Next
    
    Range("A:A").ColumnWidth = 12
    Range("B:B").ColumnWidth = 4
    Range("C:C").ColumnWidth = 10
    Range("D:D").ColumnWidth = 65
    Range("E:E").ColumnWidth = 9
    
    Range("A1:E" & j).Cells.Borders.LineStyle = XlLineStyle.xlContinuous
    
    MsgBox "Veriler alındı...."
    
    Set HTML2 = Nothing
    Set HTTP2 = Nothing
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub

.

ua_mstf · 5 Nisan 2023

Çok teşekkür ederim yardımlarınız için.

Güncel Tablo Çekme

ua_mstf

Haluk

Özel Üye

ua_mstf

Haluk

Özel Üye

ua_mstf

Haluk

Özel Üye

Haluk

Özel Üye

ua_mstf

Haluk

Özel Üye

ua_mstf

Haluk

Özel Üye

ua_mstf

Haluk

Özel Üye

ua_mstf