Birden fazla link kullanarak webden veri alma

[Yankimania]

Herkese iyi günler. ben günlük olarak 27 adet linkten 27 adet farklı liste indiriyorum. bunu gerçekleştirmek için aşağıdaki kodu buldum, uyguladım. çalışıyor, listeleri yanyana başarılı bi şekilde indiriyor ancak her çalıştığında bir önceki indirdiği veriyi yan sütunlara kaydırıyor. bunu nasıl önleyebilirim? yani özetle isteğim her linkin verisi dün nereye kopyalandıysa ertesi gün onun üzerine kopyalansın.



Sub Download_Data()

For a = 1 To 27

myurl = Trim(Cells(a, 1))

strname = Trim(Cells(a, 1))

querydata myurl, a, strname

Next a

End Sub

Sub querydata(Q_url, strrow, strname)

Dim StrRange As Range

Dim sConn As String

Dim sSql As String

Dim qt As QueryTable

Dim ws As Worksheet

Set ws = Worksheets("1. GÜN")

ws.Activate

'clear querytables

For Each qt In ActiveSheet.QueryTables

qt.Delete

Next qt

sConn = "URL;" & Q_url

sSql = ""

Set qt = ActiveSheet.QueryTables.Add( _

Connection:=sConn, _

Destination:=ws.Cells(1, 27))

With qt

.Name = strname

.WebTables = "1"



End With

qt.Refresh BackgroundQuery:=False



writetocell (strrow)

End Sub

Sub writetocell(strrow)

Dim ws As Worksheet

Set ws = Worksheets("1. GÜN")

ws.Activate

End Sub

 

[ÖmerBey]

Merhaba,
Kodun başına aşağıdaki kodu ekleyip deneyiniz.

Worksheets("1. GÜN").Range("AA:BA").Delete

 

[Yankimania]

çok teşekkür ederim yarın mesaide denicem. kolaylıklar dilerim.

 

[Yankimania]

Merhaba,
Kodun başına aşağıdaki kodu ekleyip deneyiniz.

Worksheets("1. GÜN").Range("AA:BA").Delete

Dediğiniz yöntem işe yarıyor. ancak şöyle bi problemim var. indirdiğim verileri başka bi sayfaya aktarıyorum düşeyara ile. ancak sütunlar silinince bu sefer düşeyara formülü hata veriyor. sonradan yüklenen veriler formül hata verdiğinden çalışmıyor. yardımcı olursanız çok sevinirim.

 

[ÖmerBey]

Düşeyara ile veri alıyorsanız bu haliyle de hata veriyor olması lazım, hep aynı verileri getirir... Neyse, çözüm olarak verileri başka sütuna yazdırıp oradan makro ile çekmeyi önerebilirim. Eğer örnek dosya paylaşırsanız daha doğru ilerleriz...

 

[Yankimania]

Düşeyara ile veri alıyorsanız bu haliyle de hata veriyor olması lazım, hep aynı verileri getirir... Neyse, çözüm olarak verileri başka sütuna yazdırıp oradan makro ile çekmeyi önerebilirim. Eğer örnek dosya paylaşırsanız daha doğru ilerleriz...

Dosyayı ekledim. çok teşekkür ederim ilginize. "1" yazan sekmeyi linklerin hergün değişen yerlerini güncellemek için kullanıdoyum. "1. gün" sekmesinde de birleştirip veri çekiyorum.

 

[ÖmerBey]

Örnek dosyanızı aslında çektiğiniz veriyi görmek için istemiştim. Şöyle anlatayım: Sizin verdiğiniz kod aldığı veriyi 27. sütunun ilk satırına giriyor. Daha sonra o satırı sağa sürükleyerek diğer linkteki verileri giriyor. Bu sebeple tablo dışında bir yere ilgili veriyi alıp oradan sütunlara sırasıyla aktarmayı düşünmüştüm, bunun için de satır ve sütun sayısını görmek istemiştim. Neyse başka bir şekilde deneyelim:

Sub Download_Data()

    For a = 1 To 27

        myurl = Trim(Cells(a, 2))

        strname = Trim(Cells(a, 2))

        querydata myurl, a, strname

    Next a

End Sub

Sub querydata(Q_url, strrow, strname)

    Dim StrRange As Range

    Dim sConn As String

    Dim sSql As String

    Dim qt As QueryTable

    Dim ws As Worksheet

Set ws = Worksheets("1. GÜN")

ws.Activate

'clear querytables

For Each qt In ActiveSheet.QueryTables

    qt.Delete

Next qt

sConn = "URL;" & Q_url

sSql = ""

Set qt = ActiveSheet.QueryTables.Add( _
Connection:=sConn, _
Destination:=ws.Cells(1, [COLOR="Red"]100[/COLOR]))

With qt

    .Name = strname

    .WebTables = "1"

    

End With

    qt.Refresh BackgroundQuery:=False
    
    [COLOR="Red"]Cells(1, 100).EntireColumn.Copy
    Cells(1, 54 - a).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Cells(1, 100).EntireColumn.Delete[/COLOR]
writetocell (strrow)

End Sub

 

[Yankimania]

Örnek dosyanızı aslında çektiğiniz veriyi görmek için istemiştim. Şöyle anlatayım: Sizin verdiğiniz kod aldığı veriyi 27. sütunun ilk satırına giriyor. Daha sonra o satırı sağa sürükleyerek diğer linkteki verileri giriyor. Bu sebeple tablo dışında bir yere ilgili veriyi alıp oradan sütunlara sırasıyla aktarmayı düşünmüştüm, bunun için de satır ve sütun sayısını görmek istemiştim. Neyse başka bir şekilde deneyelim:

Sub Download_Data()

    For a = 1 To 27

        myurl = Trim(Cells(a, 2))

        strname = Trim(Cells(a, 2))

        querydata myurl, a, strname

    Next a

End Sub

Sub querydata(Q_url, strrow, strname)

    Dim StrRange As Range

    Dim sConn As String

    Dim sSql As String

    Dim qt As QueryTable

    Dim ws As Worksheet

Set ws = Worksheets("1. GÜN")

ws.Activate

'clear querytables

For Each qt In ActiveSheet.QueryTables

    qt.Delete

Next qt

sConn = "URL;" & Q_url

sSql = ""

Set qt = ActiveSheet.QueryTables.Add( _
Connection:=sConn, _
Destination:=ws.Cells(1, [COLOR="Red"]100[/COLOR]))

With qt

    .Name = strname

    .WebTables = "1"

    

End With

    qt.Refresh BackgroundQuery:=False
    
    [COLOR="Red"]Cells(1, 100).EntireColumn.Copy
    Cells(1, 54 - a).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Cells(1, 100).EntireColumn.Delete[/COLOR]
writetocell (strrow)

End Sub

linkler işyerine ait sistemde çalıştığından şu anda deneyemiyorum. yarın hemen denicem. tekrar teşekkür ederim.

 

[Yankimania]

kolay gelsin. Yardımınız için öncelikle tekrar teşekkür ederim. Şöyle bir durum var kodun sonunda end with den sonraki qt. Refresh ile başlayan satırı sarı gösterip hata veriyor. Benim merak ettiğim bi gün önce 27 tane linkten indiriyorum. 27 tane liste indiğinde AA sütunundan başlayıp EE sütununda bitiyor veriler. Bi gün sonra güncelleyip indirdiğimde neden yana kaydırıyor da aynı sütunlara inmiyor? Bunu sağlamanın bi yolu varmı?