Çözüldü For Next döngüsü yardım.

[ptcsite]

Aşağıda KAP sitesinden veri alıyorum ama for döngüsünü kuramadım. Çalıştıra basınca olmuyor... Kafam basmadı bi yardımcı olsanız

Dim XMLreq As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.HTMLDocument
Dim baglan As String
Dim yakin, yakin2, eksi As Integer

'PAZARLAR
baglan = "https://www.kap.org.tr/tr/Pazarlar"
XMLreq.Open "get", baglan, False
        XMLreq.Send
   
            If XMLreq.Status <> 200 Then
            On Error Resume Next
            MsgBox "Sayfa Bulunamıyor", vbOKOnly
            End If
   
        HTMLdoc.body.innerHTML = XMLreq.responseText

'Yakın İzleme Pazarı

Sayfa1.Cells(1, 16) = HTMLdoc.getElementById("14").innerText

Sayfa1.Cells(2, 16) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(5).innerText
Sayfa1.Cells(2, 17) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(6).innerText
Sayfa1.Cells(2, 18) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(7).innerText

    For yakin = 4 To 60 Step 4
            For yakin2 = 2 To 25
                   
Sayfa1.Cells(yakin2 + 1, 16) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(yakin + 5).innerText
Sayfa1.Cells(yakin2 + 1, 17) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(yakin + 6).innerText
Sayfa1.Cells(yakin2 + 1, 18) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(yakin + 7).innerText
On Error GoTo 1

        Next
    Next
1:
End Sub

 

[ptcsite]

Döngü şu şekilde gitmeli;

'Sayfa1.Cells(3, 16) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(9).innerText
'Sayfa1.Cells(3, 17) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(10).innerText
'Sayfa1.Cells(3, 18) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(11).innerText
'
'Sayfa1.Cells(4, 16) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(13).innerText
'Sayfa1.Cells(4, 17) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(14).innerText
'Sayfa1.Cells(4, 18) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(15).innerText
'
'Sayfa1.Cells(5, 16) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(17).innerText
'Sayfa1.Cells(5, 17) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(18).innerText
'Sayfa1.Cells(5, 18) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(19).innerText

 

[ptcsite]

Çözdüm:

For yakin = 4 To 60 Step 2
yakin2 = yakin / 2

Sayfa1.Cells(yakin2 + 1, 16) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(2 * yakin + 1).innerText
Sayfa1.Cells(yakin2 + 1, 17) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(2 * yakin + 2).innerText
Sayfa1.Cells(yakin2 + 1, 18) = HTMLdoc.getElementsByClassName("column-type7 wmargin").Item(3).getElementsByTagName("div").Item(2 * yakin + 3).innerText

On Error GoTo 1

Next

1:
End Sub

 

[fatihdikmen]

iyi akşamlar;
Private Sub CommandButton1_Click()
Dim doc As Word.Document
Set wordapp = CreateObject("word.application")
sablon = "C:\Users\fatih\Desktop\uzl_2.0\şablonlar\davet_mektubu.dotx"

For i = 2 To 3

Set doc = wordapp.Documents.Open(sablon)
doc.Bookmarks("uzl_dosya_no").Range.InsertAfter Cells(i, 21)
doc.Bookmarks("adı_soyadı").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("baba_adı").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("ana_adı").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("dogum_tarihi").Range.InsertAfter Cells(i, 7)
doc.Bookmarks("tckn").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("adresi").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("ilgili_savcılık").Range.InsertAfter Cells(i, 24)
doc.Bookmarks("ilgili_savcılık_2").Range.InsertAfter Cells(i, 24)

doc.SaveAs2 "C:\Users\fatih\Desktop\uzl_2.0\hazırlanan_belgeler\" & Cells(i, 2) & " davet_mektubu ", Text

MsgBox Prompt:="DAVET MEKTUBU OLUŞTURULDU!!!"

Next i

End Sub

bu döngüyü B2 den başlayarak B sütununda değer varsa çalıştırmak için nasıl düzenlemeliyim