• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Webden Bilgi Sorgulama

  • Konbuyu başlatan Konbuyu başlatan steppe
  • Başlangıç tarihi Başlangıç tarihi
S

steppe

Katılım
7 Ağustos 2011
Mesajlar
319
Excel Vers. ve Dili
2003-2010 Türkçe
Merhaba Arkadaşlar,
Form sayfasından bulduğum örnek dosyanın içindeki kod ile yalnız USD alış ve satışını B2 ve C2 hücrelerine çekebiliyorum. Aynı kodları tekrar etmeden döngü ile EUR, Altın (Gram), Altın (Çeyrek)* ve EUR/USD Parite alış ve satışlarını B3 ve C3 aşağıya doğru nasıl çekebilirim.

Çekme işi ClassName göre yapılıyor. Ekteki kodda Alış ve satış ClassName 'leri aynı eğer satış ClassName farklı olursa nasıl bir yol izleyerek çekebiliriz.

Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

Merhaba, alternatif olarak başka bir sayfaya excel veri sekmesindeki webden veri al seçeneğiyle verileri alıp formülle çağırabilirsiniz. (Bence daha pratik)
Dosyanızdaki kodun düzenlenmiş hali aşağıdadır.
İyi çalışmalar...
Kod: 
Sub Emre()
    Set IE = CreateObject("InternetExplorer.Application")
    IE.navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Do: DoEvents: Loop Until IE.readyState = 4
    
    Range("B2").Value = IE.document.getElementsByClassName("dlCont")(1).innerText
    Range("C2").Value = IE.document.getElementsByClassName("dlCont")(2).innerText
    Range("B3").Value = IE.document.getElementsByClassName("dlCont")(4).innerText
    Range("C3").Value = IE.document.getElementsByClassName("dlCont")(5).innerText
    Range("B4").Value = IE.document.getElementsByClassName("dlCont")(7).innerText
    Range("C4").Value = IE.document.getElementsByClassName("dlCont")(8).innerText
    Range("B5").Value = IE.document.getElementsByClassName("dlCont")(10).innerText
    Range("C5").Value = IE.document.getElementsByClassName("dlCont")(11).innerText
    Range("B6").Value = IE.document.getElementsByClassName("dlContParite1")(0).innerText
    Range("C6").Value = IE.document.getElementsByClassName("dlContParite")(0).innerText
    IE.Quit
End Sub
 
mucit77 Hocam,
İlginiz için çok teşekkür ederim.

Sub Emre()
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "http://bigpara.hurriyet.com.tr/borsa/hisse-fiyatlari/"
Do: DoEvents: Loop Until IE.readyState = 4

Range("A2").Value = IE.document.getElementsByClassName("cell003 tal arrow")(0).innerText
Range("A3").Value = IE.document.getElementsByClassName("cell003 tal arrow")(1).innerText
Range("A4").Value = IE.document.getElementsByClassName("cell003 tal arrow")(2).innerText
Range("A5").Value = IE.document.getElementsByClassName("cell003 tal arrow")(3).innerText
Range("A6").Value = IE.document.getElementsByClassName("cell003 tal arrow")(4).innerText
Range("A7").Value = IE.document.getElementsByClassName("cell003 tal arrow")(5).innerText

IE.Quit
End Sub

Yukarıda örnekte hisse senetlerinin hücre adlarını
Range("A2")
Range("A3")
Range("A4")...
ve
ClassName(...)(0),
ClassName(...)(1)
ClassName(...)(3)..... sürekli tekrar etme yerine bir döngü ile çağırmak mümkün mü diye sormuştum.
 
Bu kodu bir dene

Kod: 
Private Sub CommandButton1_Click()


Dim ie As Object

Set ie = CreateObject("InternetExplorer.Application")
Columns("A:I").ClearContents
sat = 1

On Error Resume Next

With ie
.Navigate "http://bigpara.hurriyet.com.tr/borsa/hisse-fiyatlari/"
.Visible = 1
'.Width = 50
'.Height = 50
'.Left = 20
'.Top = 0
End With

For s = 1 To 8
ie.Navigate "http://bigpara.hurriyet.com.tr/borsa/hisse-fiyatlari/" & s & "/"


Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:01"))

sut = 0

For k = 188 To 592
sut = sut + 1

veri = Trim(ie.document.getElementsByTagName("li")(k).innerText)
If IsNumeric(veri) = False Then
'If sut = 9 Then
sut = 1
sat = sat + 1
Cells(sat, 1).Select
End If

If veri = "başa git" Then GoTo atla1
Cells(sat, sut).NumberFormat = "@"
Cells(sat, sut) = veri

Next k

Next s
atla1:
ie.Quit: Set ie = Nothing
MsgBox ("Bitti  ")
End Sub
 
halit3 Hocam,
Yardımlarınız için çok teşekkür ederim.Oldukça hızlı çalışıyor.Elinize,zihninize sağlık.
Acaba rica etsem geliştirmemiz açısından kodlar ne anlama geliyor yazabilir misiniz?
 
Bu kod birazcık farklı

Kod: 
Private Sub CommandButton1_Click()
Dim URL As String
Dim ie As Object
Columns("A:Z").ClearContents
Set ie = CreateObject("InternetExplorer.Application")

sat2 = 1
sat3 = 1
sut1 = 1

With ie

For s = 1 To 8

URL = "http://bigpara.hurriyet.com.tr/borsa/hisse-fiyatlari/" & s & "/"
.navigate URL
.Visible = 1
'ShowWindow ie.hwnd, 6
.Width = 50
.Height = 50
.Left = 20
.Top = 0

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.busy: DoEvents: Loop
'Application.Wait (Now + TimeValue("0:00:01"))

For Each t1 In ie.document.getElementsByClassName("cell004")
x = x + 1
sut1 = sut1 + 1

If x Mod 6 = 1 Then
'x = 0
sat2 = sat2 + 1
sut1 = 2
End If
Cells(sat2, sut1) = t1.innerText
Next

sut2 = 1
ekle = 0

For Each t2 In ie.document.getElementsByClassName("cell003")
x2 = x2 + 1
sut2 = sut2 + 1
If x2 Mod 3 = 1 Then
sat3 = sat3 + 1
sut2 = 1
ekle = 0
End If
Cells(sat3, sut2 + ekle) = t2.innerText
Cells(sat3, 1).Select
ekle = 6
Next

Next s

ie.Quit: Set ie = Nothing
End With

MsgBox ("Bitti  ")
End Sub
 
Bir Alternatif daha

Kod: 
Private Sub CommandButton1_Click()


Dim ie As Object

Set ie = CreateObject("InternetExplorer.Application")
Columns("A:Z").ClearContents
sat = 1

On Error Resume Next

With ie
.navigate "http://bigpara.hurriyet.com.tr/borsa/hisse-fiyatlari/"
.Visible = 1
.Width = 50
.Height = 50
.Left = 20
.Top = 0
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.busy: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:01"))
End With


For s = 1 To 8

ie.navigate "http://bigpara.hurriyet.com.tr/borsa/hisse-fiyatlari/" & s & "/"

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.busy: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:01"))
sat2 = 0
Set botoes = ie.document.getElementsByTagName("li")
For Each bt In botoes
sat2 = sat2 + 1
If Trim(bt.innerText) = "Hacim(TL)" Then
'MsgBox bt.innerText & Chr(10) & sat2
ilk = sat2
GoTo atla3
End If
Next

atla3:

sut = 0

For k = ilk To ilk + 450
sut = sut + 1

veri = Trim(ie.document.getElementsByTagName("li")(k).innerText)
If veri = "Sık Kullanılanlar düğmesini tıklatın, Geçmiş'i tıklatın ve sonra görüntülemek istediğiniz sayfayı tıklatın." Then GoTo atla1

If veri = "başa git" Then GoTo atla2
If veri = "sonraki" Then GoTo atla2
If veri = "1" Then GoTo atla2

If IsNumeric(veri) = False Then
'If sut = 9 Then
sut = 1
sat = sat + 1
Cells(sat, 1).Select
End If


Cells(sat, sut).NumberFormat = "@"
Cells(sat, sut) = veri

Next k
atla2:
sat = sat + 1
sut = 1

Next s
atla1:
ie.Quit: Set ie = Nothing
MsgBox ("Bitti  ")
End Sub
 
Bir alternatif kod daha

Kod: 
Private Sub CommandButton1_Click()
Dim URL As String
Dim ie As Object
Columns("A:Z").ClearContents
Set ie = CreateObject("InternetExplorer.Application")
sut1 = 1
sat1 = 1
With ie
For s = 1 To 8

URL = "http://bigpara.hurriyet.com.tr/borsa/hisse-fiyatlari/" & s & "/"
.navigate URL
.Visible = 1
.Width = 50
.Height = 50
.Left = 20
.Top = 0

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.busy: DoEvents: Loop
say = 0
For Each t1 In ie.document.GetElementsByTagName("div")
adres = Replace(Replace(WorksheetFunction.Trim(t1.InnerText), Chr(13), ""), Chr(10), "")
If Mid(Trim(adres), 1, 8) = "HisseSon" Then

adres2 = Replace(Replace(WorksheetFunction.Trim(t1.InnerText), Chr(13), ""), Chr(10), "#")
adres2 = Replace(adres2, "##", "#")

deg1 = Split(adres2, "#")
If UBound(deg1) > 0 Then

For i = 1 To UBound(deg1)
say = say + 1
sut1 = sut1 + 1

If say Mod 9 = 1 Then
sat1 = sat1 + 1
sut1 = 1
End If

Cells(sat1, sut1).Value = deg1(i)
Cells(sat1, 1).Select
Next
End If

GoTo atla1:

End If
Next

atla1:

Next s

ie.Quit: Set ie = Nothing
End With

MsgBox ("Bitti  ")
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst