Döngü ile makronun formüllerinin değiştirilmesi

[rdeniro]

İyi akşamlar!

Aşağıda yazmış olduğum kodlarla, döngüsel bir makro oluşturmak istiyorum. 1 de 150 ye kadar her seferinde f=1 in birer birer artarak 150 olduğunda makronun durmasını, bu arada alınan bilginin yazıldığı Range("A1") değerinin f, değeri 1 arttıkça 20 değer artmasını istiyorum.

Yani,
f=1 olduğunda A=21,
f=2 olduğunda A=41,
f=3 olduğunda A=61,
.
.
.
f=150 olduğunda A=3001,

bu şekilde bugün oynanan maçlarda atılan golleri excel'e yazdırmış olacağım.

Bu konuda bana yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

Saygılarımla,





Sub Makro1()


ActiveCell.FormulaR1C1 = _
"http://active.soccerstand.com/free/megabet/goals.php?f=1"

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://active.soccerstand.com/free/megabet/goals.php?f=1", Destination _
:=Range("A21"))
.Name = "goals.php?f=1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

 

[Levent Menteşoğlu]

Döngüyü aşağıdaki gibi kurabilirsiniz.

[vb:1:dd59a7febe]For f = 1 To 150
c = c + 20
Range("a" & c + 1) =........
Next
[/vb:1:dd59a7febe]

 

[rdeniro]

sayın leventm!

Her zamanki gibi ilginize teşekkür ederim.
Yanlız dediğiniz kodları aşağıdaki şekilde uyguladım.
Ancak her seferinde f'yi 1 olarak kabul ediyor ve her 20 satırda bir aynı değeri veriyor.
yani f'yi arttırmıyor.

Yardımcı olursanız sevinirim.

Sub Makro4()
'

For f = 1 To 150

c = c + 20

ActiveCell.FormulaR1C1 = _
"http://active.soccerstand.com/free/megabet/goals.php?f=1"

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://active.soccerstand.com/free/megabet/goals.php?f=1", Destination _
:=Range("a" & c + 1))
.Name = "goals.php?f=1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:8abcc3b6fa]Sub Makro4()
On Error Resume Next
For f = 1 To 150
c = c + 20
ActiveCell.FormulaR1C1 = _
"http://active.soccerstand.com/free/megabet/goals.php?f=" & f
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://active.soccerstand.com/free/megabet/goals.php?f=" & f, Destination _
:=Range("a" & c + 1))
.Name = "goals.php?f=" & f
.AdjustColumnWidth = True
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.Refresh BackgroundQuery:=False
End With
Next
End Sub
[/vb:1:8abcc3b6fa]

 

[rdeniro]

Çok teşekkür ederim, sayın leventm!

Sorun çözüldü.

 

[rdeniro]

Sayın leventm!

bu örnekte, makroyu ilk çalıştıırdığım zaman değerleri A ile D sütunları arasına yazıyor. Makroyu ikinci kez çalıştırdığım zaman bu sefer E ile H arasına yazıyor ve bu şekilde yana doğru öteleyerek gidiyor. Oysa ben her zaman değerlerin A ile D arasına yazmasını istiyorum.

Bu konuda bana yardımcı olursanız çok sevinirim.

Saygılarımla,

 

[Levent Menteşoğlu]

Kod içindeki on error resume next satırından sonra aşağıdaki satırı ilave edin.

Columns("a:d").ClearContents

 

[rdeniro]

Teşekkür ederim Sayın leventm!

Belki bu sorular size çok basit geliyor, ama inanın sizin sayenizde bizde visual basic öğreniyoruz.

Yine sorunu çözdünüz.

Çok teşekkürler