[Yardım]  Veri Çekme Yavaş

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Veri Çekme Yavaş

İleti#1)  mslmyre1 » 03 Haz 2019 01:50

Merhaba, nesine.com'dan otomatik veri çekme kodumu, msxml2.xmlhttp haline getirilirse daha hızlı çalışacağını duydum. Malesef benim ilgi alanım değil, bu konu hakkında yardımcı olursanız sevinirim... Dosyayı paylaşacağım, düzenleyip paylaşırsanız çok seviniirim. İyi bayramlar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
mslmyre1
 
Kayıt: 31 Ağu 2017 22:58
Meslek: Kaynakcı
Yaş: 23
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Veri Çekme Yavaş

İleti#2)  Ozan İLGÜN » 28 Haz 2019 15:17

Linkteki sayfada tablo kullanılmamış. Divlere stil vererek tablo gibi göstermişler. Bu yüzden tek tek divlerle uğraşmak gerekiyor.
Xmlhttp ile yaptım ama bir kaç çalışmanın haricinde sürekli hata verdi. Aşağıda bir örnek yazdım. Boş bir sayfada deneyebilirsiniz.
Kod: Tümünü seç
Sub cek()
On Error GoTo hata
Range("A1:L20").Clear
Range("A1:L20").HorizontalAlignment = xlHAlignLeft
Range("A1:L20").VerticalAlignment = xlVAlignCenter
Dim satirsayac As Integer
Dim sutunsayac As Integer
satirsayac = 1
sutunsayac = 1
Const url = "http://istatistik.nesine.com/HeadToHead/Index.aspx?matchCode=240"
Dim tablo As MSHTML.HTMLTable
Dim div As HTMLDivElement
Dim d As HTMLDivElement
Dim dd As HTMLDivElement
Dim ie As New InternetExplorer
ie.Visible = False
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
Set tablo = ie.document.getElementById("leagueTableContainer_38926")
tablo.RemoveChild tablo.LastChild
tablo.RemoveChild tablo.LastChild
tablo.RemoveChild tablo.LastChild
tablo.RemoveChild tablo.LastChild
tablo.RemoveChild tablo.LastChild
tablo.RemoveChild tablo.LastChild
tablo.RemoveChild tablo.LastChild
tablo.RemoveChild tablo.LastChild
For Each div In tablo.Children
Cells(satirsayac, 1).Value = IIf(div.HasChildNodes, Replace(div.Children(0).innerHTML, " ", ""), "-")
If satirsayac = 1 Then
sutunsayac = 3
Else
sutunsayac = 2
End If
For Each d In div.Children
For Each dd In d.Children
If sutunsayac = 2 Then Cells(satirsayac, 2).Value = resimcek(Cells(satirsayac, 2), dd.outerHTML)
If sutunsayac <> 2 Then Cells(satirsayac, sutunsayac).Value = dd.innerText
sutunsayac = sutunsayac + 1
Next dd
Next d
satirsayac = satirsayac + 1
Next div
ie.Quit
Set ie = Nothing
MsgBox "Yükleme tamamlandı."
Exit Sub
hata:
MsgBox "Bir hatayla karşılaşıldı."
ie.Quit
Set ie = Nothing
End Sub



Function resimcek(adres As Range, link As String) As String

Dim ilk As Integer
Dim son As Integer
Dim url As String
ilk = InStr(5, link, "Images/") + 12
son = InStr(ilk + 1, link, ".")
url = Mid(link, ilk, son - ilk)
If url = "Up" Then resimcek = ChrW(8593): adres.Font.ColorIndex = 4
If url = "Stand" Then resimcek = ChrW(8703): adres.Font.ColorIndex = 1 ' chrw(8651) chrw(8654) alternatifler
If url = "Down" Then resimcek = ChrW(8595): adres.Font.ColorIndex = 3

End Function
ozan.ilgun@boun.edu.tr

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 12:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 33
İleti: 2734
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: Veri Çekme Yavaş

İleti#3)  mslmyre1 » 06 Tem 2019 17:41

Bende malesef çalışmadı, excel olarak gönderirseniz sevinirim. Teşekkür ederim herşey için.
Kullanıcı avatarı
mslmyre1
 
Kayıt: 31 Ağu 2017 22:58
Meslek: Kaynakcı
Yaş: 23
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Veri Çekme Yavaş

İleti#4)  Ozan İLGÜN » 09 Tem 2019 10:12

Veri (2).rar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
ozan.ilgun@boun.edu.tr

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 12:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 33
İleti: 2734
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: Veri Çekme Yavaş

İleti#5)  mslmyre1 » 21 Tem 2019 23:34

Ozan İLGÜN yazdı:
Veri (2).rar


Teşekkür ederim çok güzel olmuş fakat benim yazdığım kodda sadece puan tablosu değil diğer verileri 'de çekebiliyordum. Onun gibi yapabilir misiniz ? Ayrıca puan tablosunda combobox bölümünde seçili olan IYpuan tablosu form tablosu vs gibi yerlern detaylı bölümünüde çekebilirsek çok memnun duyarım. Biliyorum sizi yoruyorum lütfen kusuruma bakmayın, ihtiyacım olduğu için böyle yapıyorum. Yardımcı olursanız sevinirim en kısa zamanda cevabınızı bekliyor olacağım. [yummy]
Kullanıcı avatarı
mslmyre1
 
Kayıt: 31 Ağu 2017 22:58
Meslek: Kaynakcı
Yaş: 23
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: itouchcanmedia, Yandex[Bot] ve 4 misafir

Bumerang - Yazarkafe