irfancantr
Altın Üye
- Katılım
- 18 Haziran 2007
- Mesajlar
- 625
- Excel Vers. ve Dili
- Excel 365 - İmngilizce
- Altın Üyelik Bitiş Tarihi
- 07-05-2029
Merhaba değerli forum üyeleri,
Elimde bulunan web adreslerinden webten bilgi çekiyorum. İşi daha kolaylaştırmak adına farklı bir yönteme başvurdum fakat excel kitabı 82 sayfa alımda bir donuyor.
Sayfa A1 hücresinde rakam değiştikçe makro1 adlı makroyu çalıştırıyorum.
Makro 1 in yaptığı işlem ise;
Sayfa1 de A1'den A10000'e kadar sayılar var, D1
10000 hücrelerinde ise bu rakamlara karşılık web adresleri var.
Makro 1 Sayfa3 A1 hücresinde ki rakamın karşılığından adresi alıyor ve o adresteki verileri excel sayfasına aktarıyor. Daha sonra aktarım bittiğinde sayfa3 sayfasında alınan bilgileri bir tabloya dolduruyor ve bilgilerin olduğu kısmı temizleyip tekrardan A1 hücresine +1 sayı ilavesi yapıyor. Bu şekilde işlem hiç durmadan devam ediyor.
Sorunum ise her 83. işlemde excel kitabı donuyor. Bu normal birşey mi yoksa makrolarda ufak oynamalar ile bu durumu aşabilir miyiz?
Sayfa 3 kodu ise;
Dosyam çok sade ve anlaşılır diye düşünüyorum. Sadece web adresleri yüzünden (10bin adet ) bu şekilde kabarık duruyor.
Elimde bulunan web adreslerinden webten bilgi çekiyorum. İşi daha kolaylaştırmak adına farklı bir yönteme başvurdum fakat excel kitabı 82 sayfa alımda bir donuyor.
Sayfa A1 hücresinde rakam değiştikçe makro1 adlı makroyu çalıştırıyorum.
Makro 1 in yaptığı işlem ise;
Sayfa1 de A1'den A10000'e kadar sayılar var, D1
10000 hücrelerinde ise bu rakamlara karşılık web adresleri var.Makro 1 Sayfa3 A1 hücresinde ki rakamın karşılığından adresi alıyor ve o adresteki verileri excel sayfasına aktarıyor. Daha sonra aktarım bittiğinde sayfa3 sayfasında alınan bilgileri bir tabloya dolduruyor ve bilgilerin olduğu kısmı temizleyip tekrardan A1 hücresine +1 sayı ilavesi yapıyor. Bu şekilde işlem hiç durmadan devam ediyor.
Sorunum ise her 83. işlemde excel kitabı donuyor. Bu normal birşey mi yoksa makrolarda ufak oynamalar ile bu durumu aşabilir miyiz?
Kod:
Sub Makro1()
If [Sayfa3!A1] > 100 Then Exit Sub
Cells(1, 3).FormulaR1C1 = "=VLOOKUP(RC[-2],Sayfa1!C[-2]:C[1],4,0)"
With [c1]: .Formula = .Value: End With
Const AdresUrl As String = "http://www.motorsporlari.net/car/"
Sheets("Sayfa3").Select
Range("b3:c100").Select
Selection.Clear
'Selection.QueryTable.Delete
Range("A2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & AdresUrl & [c1], Destination:=Cells(3, 2))
.Name = "bmw-320d-advantage-i2284"
.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 = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim sat, a
sat = Range("K" & Rows.Count).End(xlUp).Row + 1
On Error Resume Next
Cells(sat, "L") = [C4].Value
Cells(sat, "M") = [C5].Value
Cells(sat, "N") = [C6].Value
Cells(sat, "O") = [C7].Value
Cells(sat, "P") = [C8].Value
Cells(sat, "Q") = [C9].Value
Cells(sat, "R") = [C10].Value
Cells(sat, "S") = [C11].Value
Cells(sat, "T") = [C14].Value
Cells(sat, "U") = [C15].Value
Cells(sat, "V") = [C16].Value
Cells(sat, "W") = [C17].Value
Cells(sat, "X") = [C18].Value
Cells(sat, "Y") = [C19].Value
Cells(sat, "Z") = [C20].Value
Cells(sat, "AA") = [C21].Value
Cells(sat, "AB") = [C22].Value
Cells(sat, "AC") = [C23].Value
Cells(sat, "AD") = [C24].Value
Cells(sat, "AE") = [C25].Value
Cells(sat, "AF") = [C26].Value
Cells(sat, "AG") = [C29].Value
Cells(sat, "AH") = [C30].Value
Cells(sat, "AI") = [C31].Value
Cells(sat, "AJ") = [C34].Value
Cells(sat, "AK") = [C35].Value
Cells(sat, "AL") = [C36].Value
Cells(sat, "AM") = [C37].Value
Cells(sat, "AN") = [C38].Value
Cells(sat, "AO") = [C39].Value
Cells(sat, "AP") = [C40].Value
Cells(sat, "AQ") = [C41].Value
Cells(sat, "AR") = [C42].Value
Cells(sat, "AS") = [C43].Value
Cells(sat, "AT") = [C44].Value
Cells(sat, "AU") = [C45].Value
Cells(sat, "AV") = [C46].Value
Cells(sat, "AW") = [C47].Value
Cells(sat, "AX") = [C48].Value
Cells(sat, "AY") = [C49].Value
Cells(sat, "AZ") = [C50].Value
Cells(sat, "BA") = [C51].Value
Cells(sat, "BB") = [C52].Value
Cells(sat, "BC") = [C53].Value
Cells(sat, "BD") = [C54].Value
Cells(sat, "BE") = [C55].Value
Cells(sat, "BF") = [C56].Value
Cells(sat, "BG") = [C57].Value
Cells(sat, "BH") = [C58].Value
Cells(sat, "BI") = [C59].Value
Cells(sat, "BJ") = [C60].Value
Cells(sat, "BK") = [C61].Value
Cells(sat, "BL") = [C62].Value
Cells(sat, "BM") = [C65].Value
Cells(sat, "BN") = [C66].Value
Cells(sat, "BO") = [C67].Value
Cells(sat, "BP") = [C68].Value
Cells(sat, "BQ") = [C69].Value
Cells(sat, "BR") = [C70].Value
Cells(sat, "BS") = [C71].Value
Cells(sat, "BT") = [C72].Value
Cells(sat, "BU") = [C75].Value
Cells(sat, "BV") = [C76].Value
Cells(sat, "BW") = [C77].Value
Cells(sat, "BX") = [C78].Value
Cells(sat, "BY") = [C81].Value
Cells(sat, "BZ") = [C82].Value
Cells(sat, "CA") = [C83].Value
Cells(sat, "CB") = [C84].Value
Cells(sat, "CC") = [C85].Value
Cells(sat, "CD") = [C86].Value
Cells(sat, "CE") = [C87].Value
Cells(sat, "CF") = [C88].Value
Cells(sat, "CG") = [C89].Value
Cells(sat, "CH") = [C90].Value
Cells(sat, "CI") = [C91].Value
Cells(sat, "CJ") = [C92].Value
a = Range("L" & Rows.Count).End(xlUp).Row: Range("K2") = 1
Range("K2:K" & a).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
[a1].Value = [a1].Value + 1
End SubSayfa 3 kodu ise;
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" <> Empty Then Makro1
End Sub
