Soru Macro hata veriyor

Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Merhaba arkadaşlar,
daha önceleri sorunsuz çalışan makro, şu kısımda hata veriyor ? :

Set List = HTML.getElementById("list") 'page


Kod:
Sub DemirAL()

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText

Set List = HTML.getElementById("list") 'page
yardımcı olacak arkadaşa şimdiden teşekkürler.
 
Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Evet olabilir. Bir de site açılışına bir ileti koyulmuş. Bu daha önce yoktu
 

muratboz06

Destek Ekibi
Destek Ekibi
Katılım
23 Mart 2017
Mesajlar
552
Excel Vers. ve Dili
Office365 TR
Makro kodunun tamamını paylaşır mısınız, birde ekran görüntüsü ile almak istediğiniz alanı belirtirseniz yardımcı olabiliriz.
 
Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Kod:
Sub DemirAL()

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
  
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText

Set List = HTML.getElementById("list") 'page
Set div = List.GetElementsByTagName("DIV") 'http://www.demirfiyatlari.com/
baslik = div(0).innertext 'Başlık yazısı Günü Tarihini Güncelleme tarihi




a = 3 'Çapları burdan itibaren yaz. yani B3 satırından

'DEMİR ÇAPLARI BAŞI
Set th = List.GetElementsByTagName("TH") 'Q8  Q10 Q12 ve Q32 kısmı
For i = 0 To 3
Sheets("MalzemeGuncelFiyatlar").Cells(a, i + 1) = th(i).innertext
Next i
a = a + 1
'DEMİR ÇAPLARI SONU
  
Range("A1").Value = baslik
Range("A2").Value = "http://www.demirfiyatlari.com/"

Set Tbody = List.GetElementsByTagName("TBODY") 'Tbody ti Internet.App
For Each Tr In Tbody(0).document.all.tags("TR") 'Tbody ti IE yerine kullandım.
For f = 0 To Tr.all.tags("TD").Length - 1
Sheets("MalzemeGuncelFiyatlar").Cells(a, f + 1) = Tr.all.tags("TD").Item(f).innertext 'TD : Demir fiyatları ve iller
Next f
a = a + 1
Next
'.......................... Tbody, TD, TR, TH, Content, Table = bu değişkenlerin hepsi web sitesinin içindeki kodlardıR.
Range("A3").Value = "1 ton Fiyatıdır."
MsgBox "Güleç Demir den Demir Fiyatları Alındı", vbInformation
    Set objHTTP = Nothing
    Set HTML = Nothing
    Set List = Nothing
    Set div = Nothing
    Set th = Nothing
    Set Tbody = Nothing
    Set Tr = Nothing
    Set td = Nothing
End Sub



 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
C#:
Sub DemirAL2()
'   Haluk - 11/10/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/
    
    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim i As Long, iRow As Long, j As Integer
    
    Range("A1:D" & Rows.Count) = ""
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText
    
    Set Tables = HTML.getElementsByTagName("table")
    Set MyTable = Tables(0)
    
    For i = 0 To MyTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To MyTable.Rows(i).Cells.Length - 1
            Cells(iRow, j + 1) = Replace(MyTable.Rows(i).Cells(j).innerText, "TL", "")
        Next
    Next
 End Sub
.
 
Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
@Haluk

Çok Teşekkür ederim , Tamamdır. Elinize sağlık
 
Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
@Haluk

hocam, tablonun ilk başlığındaki : tarih ve kdv dahil nakliye hariç yazan kısım.

Bunu başlık olarak almalıyım. A1 e. Bunu nasıl yapabilirim ? ( formatlı tabloma uyarladım. sadece bu kısım kaldı.)

Range("A1").Value = baslik
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
O zaman ilk önce VBA editörde "Microsoft HTML Object Library" referansını seçeceksiniz.

Daha sonra, eskisinin yerine aşağıdaki kodu kullanacaksınız....

C#:
Sub DemirAL3()
'   Haluk - 11/10/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/
   
    Dim objHTTP As Object, strURL As String
    Dim HTML As HTMLDocument, Tables As Object, Table As Object
    Dim i As Long, iRow As Long, j As Integer
    Dim xData As Object
   
    Range("A1:D" & Rows.Count) = ""
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = New HTMLDocument
    HTML.body.innerhtml = objHTTP.responseText
   
    Set Tables = HTML.getElementsByTagName("table")
    Set MyTable = Tables(0)
   
    For i = 0 To MyTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To MyTable.Rows(i).Cells.Length - 1
            Cells(iRow, j + 1) = Replace(MyTable.Rows(i).Cells(j).innerText, "TL", "")
        Next
    Next
   
    Set xData = HTML.getElementsByClassName("card-header bg-color-grey text-3")(2)
   
    Range("A1") = xData.innerText
End Sub

.
 
Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Tamamdır. Hocam çok Teşekkürler., -- Bu akşam için son 1 soru :

sizin daha önce göndermiş olduğunuz kod ile altıpiyasası isimli siteden verileri aldım.

yalnız karakterler Türkçe değil. bunu nasıl düzeltebilirim ?

Ekran resmi ekliyorum

 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Bu akşamlık bu kadar yeter zira; bugün katarakt ameliyatı oldum, tek gözle yardımcı olmaya çalışıyorum....

.
 
Katılım
17 Haziran 2008
Mesajlar
1,836
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Abi tamamdır. Çok geçmiş olsun.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Eyvallah....sağolasın.

.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Teşekkürler Evren Bey, sağolun...

.
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,225
Excel Vers. ve Dili
Office 2019 (64 bit) - Türkçe
Geçmiş olsun üstad. Herşeyin başı sağlık...
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Eyvallah dostum.... aynen öyle 230758
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,181
Excel Vers. ve Dili
Ofis 365 Türkçe
Haluk bey, geçmiş olsun. Bu genç yaşta katarakt oluyor muymuş?
 
Üst