• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kodda hata

M

mersilen

Destek Ekibi
Destek Ekibi
Katılım
31 Aralık 2009
Mesajlar
1,105
Excel Vers. ve Dili
excel 2007 türkçe
Excel Vers. ve Dili Ofis 2003
Merhabalar
Aşağıdaki döngüde yazımda hata alıyorum, yardımlarınız için teşekkürler.
Birde bunu doğru yazmanın yolu var mı?
Kod: 
Sub galaksilerikaydet()
For galaksi = 1 To 49
For güneşsistemi = 1 To 49

    With ActiveSheet.QueryTables.Add(Connection:="URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=45", Destination:=Sheets("Sayfa5").Cells(1, 1))
        .Name = "index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=45"
        
Next güneşsistemi
Next galaksi
End Sub

galaksi = 11
güneşsistemi = 45
kırmızı yerlere gelecek


With ActiveSheet.QueryTables.Add(Connection:="URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=45", Destination:=Sheets("Sayfa5").Cells(1, 1))
.Name = "index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=45"

Bunu yaptım ama olmadı
With ActiveSheet.QueryTables.Add(Connection:="URL;" & "http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=" & galaksi & "galaxyy= " & güneşsistemi & , Destination:=Cells(1, 1))
Genişletmek için tıkla ...
 
Son düzenleme:
Tekrar selamlar
Aşağıdaki kodu oluşturdum ama buda hata veriyor
hata yeri
Refresh BackgroundQuery:=False

Kod: 
Sub galaksilerikaydet()
'
For galaksi = 1 To 1
For güneşsistemi = 1 To 1
Range("a1:m50") = Clear

Const AdresUrl As String = "URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx="
Sheets("Sayfa5").Select
Range("A2:Y100").Select
Selection.Clear
''''Selection.QueryTable.Delete
Range("A1").Select
Range("A1") = Clear
Range("A1") = "1"
   'With ActiveSheet.QueryTables.Add(Connection:="URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=47", Destination:=Sheets("Sayfa5").Cells(1, 1))
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & AdresUrl & galaksi & "&galaxyy=" & güneşsistemi, Destination:=Cells(1, 1))
    Range("A1") = "2"
        .Name = "index.php?planetenid=11250&page=galaxy&sys=&galaxyx=" & galaksi & " galaxyy = " & güneşsistemi
    Range("A1") = "3"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
    Range("A1") = "4"
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
    Range("A1") = "5"
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "5,6,7"
    Range("A1") = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
    Range("A1") = "7"
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
    Range("A1") = "8"
        .WebDisableRedirections = False
    Range("A1") = "9"
        .Refresh BackgroundQuery:=False
    Range("A1") = "10"
    End With
    Range("A1") = "11"
    Set ws = Worksheets("Sayfa1")
'ws.Range("d11:m30") = Clear
xi = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row + 1
For x = 10 To Cells(Rows.Count, "A").End(xlUp).Row - 1

If Cells(x, 1).Value <> "" Then
sat = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row + 1
For i = 4 To 11
ws.Cells(sat, 3) = Cells(7, 1)
ws.Cells(sat, i) = Cells(x, i - 3).Value
Next i
End If
Next x

Next güneşsistemi
Next galaksi
End Sub
 

Ekli dosyalar

Son düzenleme:
Biraz uğraşmayla kendim çözdüm
Çalışan kodlar aşağıda
Kod: 
Sub galaksilerikaydet()
'
For galaksi = 31 To 31
For güneşsistemi = 11 To 11
Range("a1:m50") = Clear

Const AdresUrl As String = "URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx="
Sheets("Sayfa5").Select
Range("A2:Y100").Select
Selection.Clear
''''Selection.QueryTable.Delete
Range("A1").Select
Range("A1") = Clear
Range("A1") = "http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=" & galaksi & "&galaxyy=" & güneşsistemi
   'With ActiveSheet.QueryTables.Add(Connection:="URL;http://cr-all-00.www2.cashraider.de/index.php?planetenid=11250&page=galaxy&sys=&galaxyx=11&galaxyy=47", Destination:=Sheets("Sayfa5").Cells(1, 1))
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & Range("A1").Value, Destination:=Cells(1, 1))
    Range("A1") = "2"
        .Name = "index.php?planetenid=11250&page=galaxy&sys=&galaxyx=" & galaksi & " galaxyy = " & güneşsistemi
    Range("A1") = "3"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
    Range("A1") = "4"
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
    Range("A1") = "5"
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "5,6,7"
    Range("A1") = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
    Range("A1") = "7"
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
    Range("A1") = "8"
        .WebDisableRedirections = False
    Range("A1") = "9"
        .Refresh BackgroundQuery:=False
    Range("A1") = "10"
    End With
    Range("A1") = "11"
    Set ws = Worksheets("Sayfa1")
'ws.Range("d11:m30") = Clear
xi = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row + 1
For x = 10 To Cells(Rows.Count, "A").End(xlUp).Row - 1

If Cells(x, 1).Value <> "" Then
sat = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row + 1
For i = 4 To 11
ws.Cells(sat, 3) = Cells(7, 1)
ws.Cells(sat, i) = Cells(x, i - 3).Value
Next i
End If
Next x

Next güneşsistemi
Next galaksi
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst