webde tablo gibi görünen yerdeki verileri aktarma

[Kusta]

Selamlar,
Arkadaşlar serverdan bağlanarak girdiğim web sayfasından sorgulama yapıp sonuca kadar ilerliyorum fakat çıkan sonucu (aşağıdaki yer alan koddaki verileri) excele aktaramıyorum. Burada yapmak istediğim “Ad” yazanı “B” sütununa, “Soyad” yazanı “C”, “Baba Adı” “D”, “Anne Adı” “E”, “Doğum Yıl” “F” ye yazsın istiyorum.


<td rowSpan=”1” colSpan=”1”>
<div>
<table align=”center” class=”Grid” id=”ctl02_ctlDataGrid” style=”WIDTH: 100%; BORDER-COLLAPSE: collapse; COLOR: #333333” cellSpacing=”0” cellPadding=”4”>
<tbody>
<tr align=”left” style=”FONT-WEIGHT: bold; COLOR: white; BACKGROUND-COLOR: #5d7b9d”>
<th rowSpan=”1” colSpan=”1” scope=”col></th>
<th rowSpan=”1” colSpan=”1” scope=”col>T.C. Kimlik No</th>
<th rowSpan=”1” colSpan=”1” scope=”col>Ad</th>
<th rowSpan=”1” colSpan=”1” scope=”col>Soyad</th>
<th rowSpan=”1” colSpan=”1” scope=”col>Baba Adı</th>
<th rowSpan=”1” colSpan=”1” scope=”col>Anne Adı</th>
<th rowSpan=”1” colSpan=”1” scope=”col>Doğum Yıl</th>
</tr>
<tr style=”COLOR: #333333; BACKGROUND-COLOR: #f7f6f3”>
<td rowSpan=”1” colSpan=”1”>…</td>
<td rowSpan=”1” colSpan=”1”>12345678901</td>
<td rowSpan=”1” colSpan=”1”>KADİR</td>
<td rowSpan=”1” colSpan=”1”>GÖRKEM</td>
<td rowSpan=”1” colSpan=”1”>ALİ</td>
<td rowSpan=”1” colSpan=”1”>AYŞE</td>
<td rowSpan=”1” colSpan=”1”>1982</td>
</tr>

Yazdığım kod aşağıda. kırmızı olan yerde bir hata var. Verileri excele aktarmıyor. O yüzden yukarıda sıkıntı yaşadığım yerlerin kodlarını sayfadan alarak yazdım. onlar doğrultusunda aşağıdaki kırmızı renkli alana ne yazmam gerektiğini bulamadım.
Yardımcı olursanız sevinirim.
Şimdiden teşekkür ederim.

Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://.................................."
IE.Width = 1500
IE.Height = 1000
IE.Visible = True
While IE.Busy
DoEvents
Wend
son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "A") = "" Then
Cells(i, "B") = "TC yaz"
Else
IE.document.getElementById("ctl02_ctlCriteriaControl_ctlTCKimlikNo").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents
Wend
Set TrackID = IE.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search")
IE.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend
Cells(i, "B") = IE.document.getElementById("ctl02_ctlDataGrid").Value
Cells(i, "C") = IE.document.getElementById("ctl02_ctlDataGrid").Value
Cells(i, "D") = IE.document.getElementById("ctl02_ctlDataGrid").Value
Cells(i, "E") = IE.document.getElementById("ctl02_ctlDataGrid").Value
Cells(i, "F") = IE.document.getElementById("ctl02_ctlDataGrid").Value
IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit

 

[Erdem Akdemir]

Aynı soruyu sorup cevap alamamak ve ısrarla tekrar sormak nasıl bir duygu.
Veri alınacak sitenin adını paylaşmanız gerekli.

 

[Kusta]

Aynı soruyu sorup cevap alamamak ve ısrarla tekrar sormak nasıl bir duygu.
Veri alınacak sitenin adını paylaşmanız gerekli.

Veri alınacak siteye siz giriş yapabilseniz zaten bunu yazardım. Ağdan bağlanıp giriş oluyor. sadece biz kurumdayken giriş yapabiliyoruz. dışardan giriş yapılmıyor. Sorunum bu zaten. Bu yüzden tıkandım kaldım.

 

[YUSUF44]

Excel'in dış veri al özelliği ile olmuyor mu?

 

[Haluk]

HTML sayfası kodlarının tamamını kopyalayıp buraya yazın. Başka türlü çözüm bulmak biraz zor.

Ya da, web sayfasını bilgisayara kaydetip onu ekleyin.... Belki bir şeyler çıkartabiliriz.

.

 

[Kusta]

Excel'in dış veri al özelliği ile olmuyor mu?

Malesef dış veri al özelliği ile olmuyor.

 

[muratb06]

Private Sub Test()

Dim ie As Object, i As Long, strText As String

Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
Dim tb As Object, bb As Object, tr As Object, td As Object

Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

y = 1 'Column A in Excel
z = 1 'Row 1 in Excel

ie.navigate "websitesi adresini giriniz." & vbCrLf

Do While ie.busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

Set doc = ie.document
Set hTable = doc.GetElementsByTagName("table")


For Each tb In hTable

Set hBody = tb.GetElementsByTagName("tbody")
For Each bb In hBody

Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR


Set hTD = tr.GetElementsByTagName("td")
y = 1 ' Resets back to column A
For Each td In hTD
ws.Cells(z, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1
Next tr
Exit For
Next bb
Exit For
Next tb
End Sub

Bu vba kodu sizin işinizi görecektir. Kendiniz ihtiyacınıza göre düzeltebilirsiniz.
(https://superuser.com/questions/1009341/vba-html-table-to-excel-worksheet adresinden alınmıştır.)

 

[Kusta]

Private Sub Test()

Dim ie As Object, i As Long, strText As String

Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
Dim tb As Object, bb As Object, tr As Object, td As Object

Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

y = 1 'Column A in Excel
z = 1 'Row 1 in Excel

ie.navigate "websitesi adresini giriniz." & vbCrLf

Do While ie.busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

Set doc = ie.document
Set hTable = doc.GetElementsByTagName("table")


For Each tb In hTable

Set hBody = tb.GetElementsByTagName("tbody")
For Each bb In hBody

Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR


Set hTD = tr.GetElementsByTagName("td")
y = 1 ' Resets back to column A
For Each td In hTD
ws.Cells(z, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1
Next tr
Exit For
Next bb
Exit For
Next tb
End Sub

Bu vba kodu sizin işinizi görecektir. Kendiniz ihtiyacınıza göre düzeltebilirsiniz.
(https://superuser.com/questions/1009341/vba-html-table-to-excel-worksheet adresinden alınmıştır.)

mURAT BEY TEŞEKKÜR EDERİM İLGİNİZ İÇİN. FORMÜL GÜZEL ÇALIŞIYOR GEREKLİ DÜZENLEMELERİ YAPTIM. FAKAT İLGİLİ SAYFADA İLK TABLODAKİ VERİLER GELİYOR. BANA 3. TABLO LAZIM NASIL DÜZELTSEM OLUR.

 

[Haluk]

Şunu bir deneyin ...

Sub Test2()
    Dim ie As Object, i As Long, strText As String
    
    Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
    Dim tb As Object, bb As Object, tr As Object, td As Object
    
    Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet
    
    Set wb = Excel.ActiveWorkbook
    Set ws = wb.ActiveSheet
    
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    
    y = 1 'Column A in Excel
    z = 1 'Row 1 in Excel
    
    ie.navigate "websitesi adresini giriniz."
    
    Do While ie.busy: DoEvents: Loop
    Do While ie.ReadyState <> 4: DoEvents: Loop
    
    Set doc = ie.document
    Set hTable = doc.GetElementsByTagName("table")
    Set tb = hTable(2)
    Set hBody = tb.GetElementsByTagName("tbody")
    
    For Each bb In hBody
        Set hTR = bb.GetElementsByTagName("tr")
        For Each tr In hTR
            Set hTD = tr.GetElementsByTagName("td")
            y = 1 ' Resets back to column A
            For Each td In hTD
                ws.Cells(z, y).Value = td.innertext
                y = y + 1
            Next td
            DoEvents
            z = z + 1
        Next tr
    Next bb
End Sub

.

 

[muratb06]

Haluk Beyin değişikliği size yardımcı olacaktır. Haluk Bey teşekkürler.

ASUS_Z00LD cihazımdan Tapatalk kullanılarak gönderildi

 

[Kusta]

Haluk Beyin değişikliği size yardımcı olacaktır. Haluk Bey teşekkürler.

ASUS_Z00LD cihazımdan Tapatalk kullanılarak gönderildi

Ellerinize sağlık. Ben kendime göre formüle ettim ve çalışıyor.
Ancak bende "A" hücresinde TC kimlik numaraları yazıyor. (A1 hariç, başlık yazdığı için). Formül "A2" hücresindeki TC'den veriyi çekiyor. fakat excele aktarırıken tekrar "A2" hücresinden başlamak üzere "B2", "C2", "D2" VE "E2" hücrelerine atıyor ve sıra "A3" hücresindeki veriyi çekip atmaya geldiğinde yine aynı yere yani "A2" "B2" "C2" "D2" ve "E2" hücrelerinin üstüne yazıyor.
İsteyipte yapamadığım "A2" de yer alan tc den çekilen veriyi "B2" den başlamak üzere 2. satıra("B2","C2","D2" diye gitsin), "A3" den çekilen veriyi "B3" den başlayarak 3. satıra atması.

Kod aşağıdadır.

Sub Arama()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "http://portalint.............."
ie.Width = 1500
ie.Height = 1000
ie.Visible = True
While ie.Busy
DoEvents
Wend
son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "A") = "" Then
Cells(i, "B") = "TC GİRİN"
Else

ie.document.getElementById("ctl02_ctlCriteriaControl_ctlTCKimlikNo").Value = Cells(i, "A")
ie.Visible = True
While ie.Busy
DoEvents
Wend

Set TrackID = ie.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search")
ie.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search").Click
ie.Visible = True
While ie.Busy
DoEvents
Wend


Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
Dim tb As Object, bb As Object, tr As Object, td As Object

Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet

y = 1 'Column A in Excel
z = 1 'Row 1 in Excel
Do While ie.Busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

Set doc = ie.document
Set hTable = doc.GetElementsByTagName("table")
Set tb = hTable(5)
Set hBody = tb.GetElementsByTagName("tbody")

For Each bb In hBody
Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR
Set hTD = tr.GetElementsByTagName("td")
y = 1 ' Resets back to column B
For Each td In hTD
ws.Cells(z, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1
Next tr
Next bb

End If
Next

End Sub

 

[Kusta]

Arkadaşla y=2 yaparak B hücresinden başlayarak yazma işini çözdüm.
Problem olarak sadece "A2" deki tc de yapılan sorguyu yanına yani 2. satıra, "A3" de yapılan sorgunun sonucunu 3. satıra ve bu şekilde devam ederek yamasını istiyorum.