Arkadaşlar kolay gelsin.
Excele webden veri çekiyorum, sistem şöyleki
"A2" sütunundaki TC ile portal üzerinden sorgulama yapıyor ve sorgulama sonucu webde yer alan tablo verilerini, excelin sırasıyla "B2, C2, D2 VE E2" sütunlarına yazıyor.
Sonra "A3" sütunudaki TC ile portal üzerinden sorgulama yapıyor ancak çıkan yeni tablo verilerini "B3, C3, D3 VE E3" sütunlarına yazması gerekirken yine "B2, C2, D2 VE E2" sütunlarının üstüne yazıyor.
İstediğim; sorgulanan TC kimlik numarasının yazılı olduğu sütunun karşısına gelen sütunlara verileri yazması.
Formül aşağıdaki gibidir yardımcı olabilirseniz sevinirim.
Site ismi veremiyorum giremezsiniz çünkü. Server üzerinden bağlanıyoruz.
Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://portalint...............aspx"
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 Gir!!!"
Else
IE.document.getElementById("ctlTcKimlikNo").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents
Wend
Set TrackID = IE.document.getElementById("Command..............._CommandItem_.........................Sorgula")
IE.document.getElementById("Command..............._CommandItem_.........................Sorgula").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend
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(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")
Set td = hTable
y = 2 ' 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
IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit
End Sub
Excele webden veri çekiyorum, sistem şöyleki
"A2" sütunundaki TC ile portal üzerinden sorgulama yapıyor ve sorgulama sonucu webde yer alan tablo verilerini, excelin sırasıyla "B2, C2, D2 VE E2" sütunlarına yazıyor.
Sonra "A3" sütunudaki TC ile portal üzerinden sorgulama yapıyor ancak çıkan yeni tablo verilerini "B3, C3, D3 VE E3" sütunlarına yazması gerekirken yine "B2, C2, D2 VE E2" sütunlarının üstüne yazıyor.
İstediğim; sorgulanan TC kimlik numarasının yazılı olduğu sütunun karşısına gelen sütunlara verileri yazması.
Formül aşağıdaki gibidir yardımcı olabilirseniz sevinirim.
Site ismi veremiyorum giremezsiniz çünkü. Server üzerinden bağlanıyoruz.
Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://portalint...............aspx"
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 Gir!!!"
Else
IE.document.getElementById("ctlTcKimlikNo").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents
Wend
Set TrackID = IE.document.getElementById("Command..............._CommandItem_.........................Sorgula")
IE.document.getElementById("Command..............._CommandItem_.........................Sorgula").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend
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(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")
Set td = hTable
y = 2 ' 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
IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit
End Sub
