• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

    Giriş yap veya Şimdi kayıt ol

Çözüldü vba ile interneten veri almak

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
C

c.sadak

Yeni Üye
Katılım
15 Şub 2023
Mesajlar
118
Çözümler
1
Aldığı beğeni
14
Excel V
Office 2021 TR
iyi akşamlar herkese
arkadaşlar sizlerden biraz yardım istiyorum dosyamda döviz adlı sayfaya makro ile döviz kurunu çekiyorum benim sizden istediğim bu iş kodlarla otomatik yapılması www.döviz.com sayfasında verinin çekilmesi şimdiden şekekürler
 

Ekli dosyalar

Çözüm
Refaz
Merhaba.
Dediğiniz hücre birleştirilmiş hücreydi çözdüm.

Dosya ekte ve B1 e Amerikan Doları geliyor koddan değiştirirsiniz Euro olacaksa.
Me.Listele kodu altına DovizAL yazdım.

Animation.gif


C#: 
Sub DovizAL()
    Dim alis As Double, satis As Double, syfAna As Worksheet
    ActiveSheet.Unprotect "5166196"
    Set HTML = CreateObject("htmlfile")
   
    Set syfAna = ThisWorkbook.Worksheets("Anasayfa")
    syfAna.Range("B1").Value = ""
   
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://kur.doviz.com/kapalicarsi", False
        .send
        HTML.body.innerHTML = .responseText
    End With


    For Each tr In HTML.getElementsByClassName("table sortable")(0).getElementsByTagName("tr")
        For Each td...
Tarihe göre sırala Oylara göre sırala
c.sadak' Alıntı:
anasayfa dolar c1 euro d1 gelsin
Genişletmek için tıkla...
Birleştirilmiş hücre olduğu için A2 ve A3 yaptım ayarlarsınız.
Modüle ekleyip DovizAL bunu çalıştırın.

If ss = 1 And say = 2 ve If ss = 2 And say = 2 burkaki 2 ler Alış getirir 3 yazarsanız Satış gelir.
Belki kısa kod vardır ama bende bilmiyorum arşivden kodları uyarlaya uyarlaya böyle sonuç çıktı.

C#: 
Sub DovizAL()
    Dim ss As Integer, say As Integer
    Set html = CreateObject("htmlfile")
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://xn--dviz-5qa.com/", False
        .send
        html.body.innerHTML = .responseText
    End With
    
    
    For Each tr In html.getElementsByClassName("table-responsive")(0).getElementsByTagName("tr")
        For Each td In tr.getElementsByTagName("td")
            If td.innerText = "ABD DOLARI" Then
                ss = 1: say = 1: GoTo 10
            End If
            
            If td.innerText = "EURO" Then
                ss = 2: say = 1: GoTo 10
            End If
            
            If ss = 1 And say = 2 Then Yazdir 1, td.innerText
            If ss = 2 And say = 2 Then Yazdir 2, td.innerText
10
            If ss = 1 Or ss = 2 Then say = say + 1

        Next
    Next
    Set html = Nothing
 End Sub


Sub Yazdir(ByVal kac As Integer, ByVal deger)
    With ThisWorkbook.Worksheets("Anasayfa")
        .Unprotect "5166196"
        If kac = 1 Then
            .Range("A2").Value = ""
            .Range("A2").Value = deger
        End If
       
        If kac = 2 Then
            .Range("A3").Value = ""
            .Range("A3").Value = deger
        End If
        .Protect "5166196"
    End With
End Sub
 
Son düzenleme:
Olumlu oy 0 Negatif oyla
Refaz' Alıntı:
Birleştirilmiş hücre olduğu için A2 ve A3 yaptım ayarlarsınız.
Modüle ekleyip DovizAL bunu çalıştırın.

If ss = 1 And say = 2 ve If ss = 2 And say = 2 burkaki 2 ler Alış getirir 3 yazarsanız Satış gelir.
Belki kısa kod vardır ama bende bilmiyorum arşivden kodları uyarlaya uyarlaya böyle sonuç çıktı.

C#: 
Sub DovizAL()
    Dim ss As Integer, say As Integer
    Set html = CreateObject("htmlfile")
   
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://xn--dviz-5qa.com/", False
        .send
        html.body.innerHTML = .responseText
    End With
   
   
    For Each tr In html.getElementsByClassName("table-responsive")(0).getElementsByTagName("tr")
        For Each td In tr.getElementsByTagName("td")
            If td.innerText = "ABD DOLARI" Then
                ss = 1: say = 1: GoTo 10
            End If
           
            If td.innerText = "EURO" Then
                ss = 2: say = 1: GoTo 10
            End If
           
            If ss = 1 And say = 2 Then Yazdir 1, td.innerText
            If ss = 2 And say = 2 Then Yazdir 2, td.innerText
10
            If ss = 1 Or ss = 2 Then say = say + 1

        Next
    Next
    Set html = Nothing
 End Sub


Sub Yazdir(ByVal kac As Integer, ByVal deger)
    With ThisWorkbook.Worksheets("Anasayfa")
        .Unprotect "5166196"
        If kac = 1 Then
            .Range("A2").Value = ""
            .Range("A2").Value = deger
        End If
      
        If kac = 2 Then
            .Range("A3").Value = ""
            .Range("A3").Value = deger
        End If
        .Protect "5166196"
    End With
End Sub
Genişletmek için tıkla...
çok teşekürler
kuru nerden alıyor serbest piyasadanmı yoksa mrkz bankasındamı alıyor
 
Olumlu oy 0 Negatif oyla
Biraz daha kafa yorunca kod kısaldı öncekinde biraz saçma kodlar yazmışım :)

'MsgBox deger(1).innerText 'Döviz türü bu kod Dolar ve Euro adını veriri eğer eklerseniz diye pasif yaptım ayarlarsınız artık.

C#: 
Sub DovizAL()
    Dim syfAna As Worksheet
  
    Set html = CreateObject("htmlfile")
  
    Set syfAna = ThisWorkbook.Worksheets("Anasayfa")
    syfAna.Unprotect "5166196"
    syfAna.Range("A2:A5").Value = ""
  
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://xn--dviz-5qa.com/", False
        .send
        html.body.innerHTML = .responseText
    End With
  
    For Each tr In html.getElementsByClassName("table-responsive")(0).getElementsByTagName("tr")
        For Each td In tr.getElementsByTagName("td")
            Set deger = tr.getElementsByTagName("td")
            If td.innerText = "ABD DOLARI" Then
                'MsgBox deger(1).innerText 'Döviz türü
                syfAna.Range("A2").Value = deger(2).innerText 'Alis
                syfAna.Range("A3").Value = deger(3).innerText 'Satis
            End If
            If td.innerText = "EURO" Then
                'MsgBox deger(1).innerText 'Döviz türü
                syfAna.Range("A4").Value = deger(2).innerText 'Alis
                syfAna.Range("A5").Value = deger(3).innerText 'Satis
            End If
            Set deger = Nothing
        Next
    Next
    syfAna.Protect "5166196"
    Set html = Nothing: Set syfAna = Nothing
 End Sub
 

Ekli dosyalar

Son düzenleme:
Olumlu oy 0 Negatif oyla
Son olarak şunu yazayım.
ilk mesajınızdaki linke tıklayınca önceki mesjda yazdığım sayfa açılıyordu ordan yapmıştım.
Sonra döviz.com u manuel açtım ve oran serbest piyasa ve kapalı çarşı verilerini çektirdim ve dosya adına yazdım.
Sadece tek sayfada yaptım kendinize ayarlarsınız ve .Open "GET" burdaki adres farklı geri kalan herşey aynı kapalı ve serbest için.
Kodlara daha fazla döviz türü ekleyeceksenizde koda devam edersiniz yada döngüyle yaparsınız duruma göre.
Ayrıca ikisi beraber bir dosyada olarak eklendi.
 

Ekli dosyalar

Son düzenleme:
Olumlu oy 0 Negatif oyla
merhaba kusura bakma ne yaptıysam ayarlayamadım
Altaki kodun içine sadeca kapaalı çarşı alş fiyatını anasayfanın B1 hücresine getirebilimisiniz size zahmet
döviz kodları için ayrı botton istemiyorum çünkü

Not Bu gürünmeyen harf D yani (A7:D107)


Private Sub LİSTELE_Click()
Application.ScreenUpdating = False
ActiveSheet.Unprotect "5166196"
On Error Resume Next
Sheets("Anasayfa").Range("A7:D106") = ""
Me.Listele
ActiveSheet.Protect "5166196", AllowFiltering:=True
Application.ScreenUpdating = True
End Sub
 
Olumlu oy 0 Negatif oyla
merhaba kusura bakma ne yaptıysam ayarlayamadım
ekteki kodun içine sadeca kapaalı çarşı alş fiyatını anasayfanın B1 hücresine getirebilimisiniz size zahmet
döviz kodları için ayrı botton istemiyorum çünkü


yokardaki kodun tamamı güzükmediği için tekrar yazdım
 

Ekli dosyalar

Olumlu oy 0 Negatif oyla
Merhaba.
Dediğiniz hücre birleştirilmiş hücreydi çözdüm.

Dosya ekte ve B1 e Amerikan Doları geliyor koddan değiştirirsiniz Euro olacaksa.
Me.Listele kodu altına DovizAL yazdım.

Animation.gif


C#: 
Sub DovizAL()
    Dim alis As Double, satis As Double, syfAna As Worksheet
    ActiveSheet.Unprotect "5166196"
    Set HTML = CreateObject("htmlfile")
   
    Set syfAna = ThisWorkbook.Worksheets("Anasayfa")
    syfAna.Range("B1").Value = ""
   
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://kur.doviz.com/kapalicarsi", False
        .send
        HTML.body.innerHTML = .responseText
    End With


    For Each tr In HTML.getElementsByClassName("table sortable")(0).getElementsByTagName("tr")
        For Each td In tr.getElementsByTagName("td")
            Set deger = tr.getElementsByTagName("td")
           
            If Left(Trim(Replace(deger(0).innertext, vbNewLine, "")), 3) = "USD" Then
                alis = CDbl(deger(1).innertext)
                YazdirHucreye "USD(Amerikan Dolari)", "B1", alis, syfAna
            End If
'            If Left(Trim(Replace(deger(0).innertext, vbNewLine, "")), 3) = "EUR" Then
'                alis = CDbl(deger(1).innertext)
'                YazdirHucreye "EUR(Euro)", "B1", alis, syfAna
'            End If
            Set deger = Nothing
        Next
    Next
     ActiveSheet.Protect "5166196"
    Set HTML = Nothing: Set syfAna = Nothing
   
 End Sub


Sub YazdirHucreye(turHcr As String, alisHcr As String, alisDeger As Double, syf As Worksheet)
    With syf
        .Range(alisHcr).Value = alisDeger: .Range(alisHcr).NumberFormat = "#,##0.00" 'Alis
    End With
End Sub
 

Ekli dosyalar

Olumlu oy 1 Negatif oyla
Çözüm
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst