- Katılım
- 11 Mart 2005
- Mesajlar
- 3,039
- Excel Vers. ve Dili
- Office 2013 İngilizce
Merhabalar,
https://www.opet.com.tr/akaryakit-fiyatlari-arsivi
sitesinden aşağıdaki kod iiel akaryakıt fiyatları çekmek istediğimde web sitesi ekranında göründüğü gibi değil, ekli ekranda görüntüsünde olduğu gibi karışık bir yapıda gelmekte;
Tabloda sadece tarih ve fiyat bilgilerinin olduğu şekliyle nümerik bir formatta gelmesi için nasıl bir düzenleme yapmamız gerekecektir.
ilginiz için şimdiden teşekkürler,
iyi çalışmalar.
https://www.opet.com.tr/akaryakit-fiyatlari-arsivi
sitesinden aşağıdaki kod iiel akaryakıt fiyatları çekmek istediğimde web sitesi ekranında göründüğü gibi değil, ekli ekranda görüntüsünde olduğu gibi karışık bir yapıda gelmekte;
Tabloda sadece tarih ve fiyat bilgilerinin olduğu şekliyle nümerik bir formatta gelmesi için nasıl bir düzenleme yapmamız gerekecektir.
ilginiz için şimdiden teşekkürler,
iyi çalışmalar.
Kod:
Sub Tablo_Al_Aktar14()
On Error Resume Next
Dim SH As Worksheet
Dim sh1 As Worksheet
Dim URL As String
Dim IE As New InternetExplorer
Dim doc As HTMLDocument
Dim btn As String
Dim Nesne As Object
Dim e As Object
Dim myCls As String
Dim strCls As String
Dim r As Long
Dim c As Byte
Dim htmldoc As MSHTML.HTMLDocument
Dim htmlTablo As MSHTML.IHTMLElement
Dim htmlTab As MSHTML.IHTMLElement
Dim htmlTablolar As MSHTML.IHTMLElementCollection
Dim htmlSatir As MSHTML.IHTMLElement
Dim htmlElaman As MSHTML.IHTMLElement
Application.DisplayAlerts = False
Set SH = Sheets("Data")
Set sh1 = Sheets("Sayfa4")
SH.Activate
URL = "https://www.opet.com.tr/akaryakit-fiyatlari-arsivi"
With IE
.Visible = True
.navigate URL
End With
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set htmldoc = IE.document
Application.Wait (Now + TimeValue("00:00:02"))
sh1.Activate
sh1.Cells.Clear
r = 0
c = 1
Set htmlTablolar = htmldoc.getElementsByTagName("table")
For Each htmlTablo In htmlTablolar
strCls = "FuelPriceArchive-module_tableFuelPriceArchive--1kE table table-nowrap table-keyvalue table-small-head"
If htmlTablo.className = strCls Then
r = r + 2
For Each htmlSatir In htmlTablo.getElementsByTagName("tr")
c = 1
For Each htmlElaman In htmlSatir.Children
sh1.Cells(r, c) = htmlElaman.innerText
c = c + 1
Next htmlElaman
r = r + 1
Next htmlSatir
End If
Next htmlTablo
''sh1.Range("A:Z").EntireColumn.AutoFit
Set SH = Nothing
Set sh1 = Nothing
40:
Application.DisplayAlerts = True
IE.Quit
Set htmldoc = Nothing
''Call DUZENLE
MsgBox "İşlem Tamam", vbInformation, "Bilgi"
End Sub
[code]
