excele dış veri alma makrosunu düzenlemek

[hayri tekin]

Selam arkadaşlar..Elimde aşağıdaki gibi bir makro var.Ama alacağım veri birden fazla olduğu için bu makroyu daha düzenli ve kısa yapmak gerekiyor.Makroda örnek olarak "ACIBD" yapılmıştır.Oysa ben "ADANA" , "AFYON" vs.gibi yeni hisselere ait bilgileri de almak istiyorum.Excell başlangıç satırı "A1" oluyor,ikinci hisse "A10",üçüncü hisse "A20" hücreleriyle başlıyor.İlgilenen arkadaşlara şimdiden çok teşekkür ediyorum.


Sub hayrit1()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.turkishbulls.com/StockPage.asp?CompanyTicker=ACIBD&MarketTicker=Services&TYP=S" _
, Destination:=Range("A1"))
.Name = "StockPage.asp?CompanyTicker=ACIBD&MarketTicker=Services&TYP=S"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "18"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

 

[Levent Menteşoğlu]

Yukarıdaki satırdaki arayacağınız veriyi değişken yapabilirsiniz. Örneğin arayacağınız verileri sayfa2de A sütununa A1 den başlamak üzere altalta yazın. Sonrasında aşağıdaki kodu çalıştırın.

Sub hayrit1()
Set s1 = Sheets("sayfa2")
For a = 1 To s1.[a65536].End(3).Row
say = WorksheetFunction.CountA([a:a]) + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.turkishbulls.com/StockPage.asp?CompanyTicker=" & s1.Cells(a, "a") & "&MarketTicker=Services&TYP=S" _
, Destination:=Cells(say, "a"))
.Name = "StockPage.asp?CompanyTicker=" & s1.Cells(a, "a") & "&MarketTicker=Services&TYP=S"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "18"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next
End Sub

Not: Kod içindeki "services" ifadeside değişken ise bunuda sayfa2 B sütununda tanımlayarak kod içinde değişken olarak aynı şekilde tanımlayabilirsiniz.

 

[hayri tekin]

dışveri taransferi

Sayın üstad öncelikle ilginize ve emeğinize çok teşekkür ediyorum.Konuyu farklı bir bakış açısıyla değerlendirmişsiniz.Fakat işleyişte bazı sorunlar yaratıyor.Ben her bir hisse verisi için 10 satır ayırmıştım.Yani "B1" hücresinde hisse adı, "A1" hücresinde bu hisseye ait verilerin başlangıç yeri.Yine "B11" hücresinde hisse adı,"A11" hücresinde bu hissenin veri başlangıcı şeklinde düşündüm.Eğer bu şekilde bir veri taransferi olursa çok daha kullanışlı olacak.(dosyam ektedir.) Saygılar..

 

[Necdet]

Dış Veri Al Değişken Olsun

Merhaba,

Sub hayrit1()
Set s1 = Sheets("Sayfa1")
s1.Select
Columns(1).Clear
For i = 1 To [B65536].End(3).Row Step 10
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.turkishbulls.com/StockPage.asp?CompanyTicker=" & s1.Cells(i, "B") & "&MarketTicker=Services&TYP=S" _
        , Destination:=s1.Cells(i, "A"))
        .Name = "StockPage.asp?CompanyTicker=" & s1.Cells(i, "B") & "&MarketTicker=Services&TYP=S"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "18"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Next
End Sub

 

[hayri tekin]

teşekkür

Çok saygıdeğer üstatlar..göstermiş olduğunuz ilgi beni çok mutlu etti.Her iki öneriniz de birbirinden güzel.Aradığım tam olarak buydu.Emeğinize sağlık,harikasınız..Saygılarımı sunuyorum..Teşekkürler..

 

[Necdet]

Ben birşey yapmadım, sadece Levent Bey'in kodlarını sizin ihtiyacınıza göre düzenledim.

Yazmayı unutmuşum sayenizde açıklamış oldum.