internetten veri çekmede sıkıntım var?

[Kemal Demir]

Arkadaslar iyi akşamlar.
Aşagıdaki kodda Sheet4 'ün 2 kolonundaki değerlere göre sayfa ismini yazdırırıp.
Sheet4 te a kolonunda a1 den a20 ye kadar olan dongu yapabilmemiz için ne gibi değişiklik yapılması gerekir.
Kırmızı İle Yazılı olan Kısım a1 den a20 ye kadar bir dongu içericek.


Sub sayfaac()
For c = 1 To 20

Sheets.Add , after:=Sheets(Sheets.Count)
ActiveSheet.Name = Sheets("Sheet4").Cells(c, 2).Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.firmalaristanbul.com/?main=Search&&SEKTOR_ID0=2&KOD=&SEMT_ID=&FALIYET_ID0=&FIRMA=&s=20&is=8&sira=1" _
, Destination:=Range("A1"))
.Name = _
"?main=Search&&SEKTOR_ID0=2&KOD=&SEMT_ID=&FALIYET_ID0=&FIRMA=&s=20&is=8&sira=1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
Next
Sheets("Sheet4").Select
End Sub
Dosyayı ekliyorum yardımcı olursanız Sevinirim.

 

[Kemal Demir]

tıkandım yardımcı olacak arkadas var mı? :kafa: :dua: :kafa: :dua: :yardim:

 

[Kemal Demir]

Günaydın Arkadaslar.
Konu hakkında Sık bogaz etmek istemiyorum.
Ama Bu konuda yardımcı olursanız cok sevinirim.
:dua: :yardim:

 

[ALPEN]

Akaryakıt şirketlerini mi istiyorsunuz?

 

[Kemal Demir]

Aslında sole solesem daha sağlıklı olur diye dusnuyorum.

Sheet4 sayfasının a1:a20 arasında belirtilen linkleri Dongusel olarak verileri excele alması.
(Bu durum sadece Akaryakıtlar için gecerli değil) Birden fazla sektor için elimde her sektorun 15 ile 50 arasında linkler i mevcut.
her sektor ıcın ayrı yapmam gerekıcek [sonu: yukarıdaki belirtilen linkte a1:a20 arasındaki linkleri almasını istiyorum.]

Çok Teşekkur Ederim.

İyi Çalışmalar.

 

[ALPEN]

İnceleyiniz.

 

[ALPEN]

Bir önceki dosya hatalı. Bunu inceleyiniz.

 

[Kemal Demir]

sn.Alpen

Ã?ncelikle İlginiz İçin ayrıyetten sizlere teşekkur ederim.

Yalnız Benım hatamdan kaynaklanan bir durum söz konusu;

Bu durum başa userform'u cıkarmamısım.

Benim Aslında Yapmak İstediğimi Esas Durum Sheet 4 Sayfası içerisinde a1:a20 arasında var olan linkler'den sayfa ekleyerek verilerin alınması.

Tekrar Ã?zür Dileyerek Modul'un içerisinde Var olan bir Kodda nasıl bir ilave yapabilirizki verileri sadece Sheet4'ün a1:a20 arasındaki linkleri okutmamaız için.

dosyanı Gerçek Halini Yolluyorum.


Tekrar Tekrar Ã?zür Dilerim.
Tekrar Teşekkur Ederi.

 

[ALPEN]

Son gönderdiğim dosyayı incelediniz mi?
Tam olarak istediğinizi yapıyor.

 

[Kemal Demir]

Çok teşekkur ederim

Daha sonra yolladınız tam istediğim gibi eline sağlık

 

[ALPEN]

Combodan sektör seçildiğinde o sektöre ait tüm firmaları getiren bir uygulama ile uğraşıyordum. İşim çıktı.

Yarın biraz daha geliştirilmişini yollayacağım.

 

[Kemal Demir]

Çok teşekkur ederim.

Sorunumm Çözüldü ama sizinde işiniz var muhakkak size katılıyorum.

Yalnız Þöle Birşey Çözüm olabilirmi(Affınıza Sıgınarak)

Yollamıs oldugum 2. dosyamda Þöle Bir durum Söz konusu alınacak olan veririn adresını yazılı olan a1 ile a10 arasındaki verilerden okutmak ıstersek nasıl bir şey yapabiliriz.

Sizlere Tekrar Teşekkuru bir boc biliyorum.

 

[Kemal Demir]

Aslında yazıp yazmamakta tereddutte kaldım ama yınede yazmaya karar verdim.
Sn.Alpen

İş Yoğunlugunuzun Oldugu kanısındayım ve konu hakkında daha detaylı bir çalışma yapacagınızı ilettiniz.Ama Ben Yine Sunu Ã?ğrenmek İstiyorum

"URL;[vb:1:cc52829b9a]http://www.firmalaristanbul.com/?main=Search&&SEKTOR_ID0=2&KOD=&SEMT_ID=&FALIYET_ID0=&FIRMA=&s=20&is=8&sira=1[/vb:1:cc52829b9a]"

bu kodda bole bir dongu yapmamız mumkun mudur.Ki değil olmadı ama nasıl bir değişiklik yapmam gerebilir.

Link aralıgı:Range("a1:a20") olarak kabul edersek;

Sub sayfaac()
[vb:1:cc52829b9a]For c = 1 To 20

Sheets.Add , after:=Sheets(Sheets.Count)
ActiveSheet.Name = Sheets("Sheet4").Cells(c, 2).Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;Cells(c,1).value" _
, Destination:=Range("A1"))
.Name = _
"?main=Search&&SEKTOR_ID0=2&KOD=&SEMT_ID=&FALIYET_ID0=&FIRMA=&s=20&is=8&sira=1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
Next
Sheets("Sheet4").Select
End Sub[/vb:1:cc52829b9a]


Verdiğim Rahatsızlıktan Dolayı Ã?zür Dilerim.
İyi Çalışmalar.

 

[ALPEN]

[vb:1:0d4d78a5a1]For c = 1 To 20

Sheets.Add , after:=Sheets(Sheets.Count)
ActiveSheet.Name = Sheets("Sheet4").Cells(c, 2).Value
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Cells(c,1).value _
, Destination:=Range("A1"))
.Name = _
"?main=Search&&SEKTOR_ID0=2&KOD=&SEMT_ID=&FALIYET_ID0=&FIRMA=&s=20&is=8&sira=1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
Next
Sheets("Sheet4").Select
End Sub[/vb:1:0d4d78a5a1]

 

[Kemal Demir]

Sn.Alpen
Zannedersem Ben Yapamadım ,yapamıyorum ve yapamıcam :kafa: :kafa: :agla: :roll: :yardim:

Dosyayı Ekliyorum .

Vaktınız var ise Değerli vaktınızden zaman ayırabilirmisiniz. :dua: :dua:

İyi Çalışmalar

 

[ALPEN]

İnceleyin...

Birde forumda soru sormak en doğal hakkınız. Lütfen bu kadar kompliman yapmayınız.

Utandım vallaha. :mrgreen:

 

[Kemal Demir]

Büyüksün Usta :hey: :bravo: :bravo: :bravo: :bravo: :hey: