Güncel Market Fiyatları İnternetten Bulmak

Haluk · 9 Mart 2023

beab05' Alıntı:
Ben resimleri istersiniz diye bekliyordum

Neyseki VBA ile parçaları birleştirip, araba yapılması istenmedi

Şaka bir yana, 70 adet ürün için sunucuya 70 defa istek gönderip geri dönen sonucu ayıklamak gerekir. Hem Excel'e yazık olur, hem de bana.....

.

serkagkx · 9 Mart 2023

beab05' Alıntı:
Ben resimleri istersiniz diye bekliyordum

doğru söylüyorsun o da lazım

serkagkx · 9 Mart 2023

Haluk' Alıntı:
Neyseki VBA ile parçaları birleştirip, araba yapılması istenmedi

Şaka bir yana, 70 adet ürün için sunucuya 70 defa istek gönderip geri dönen sonucu ayıklamak gerekir. Hem Excel'e yazık olur, hem de bana.....

.

valla hocam uğraştırıyoruz senide ama 1 haftadan fazladır çözüm arıyorum ya 10 dk da çözdük neredeyse

beab05 · 9 Mart 2023

Zaten tüm sayfalar içindeki ürünleri tek seferde almak doğru olmaz. Bunun bir sürü dezavantajı var. Bu sebeple önce sayfalar listelenmeli ve sonra seçilen sayfaya göre kullanıcı istek yapmalı. Ya da ilk sayfa verileri alınır ve diğer sayfa numaraları da da uygun bir yere yazdırılır combobox gibi ve seçilip sorgulanır.

Ya da kullanıcı sayfaları ve linki bir hücreye manuel girsin ve ve öyle aratsın. Bir hücreye linki bir hücreye sayfa numarasını..

Haluk · 9 Mart 2023

Ürün açıklamalarına alternatif olarak; A sütunundaki ürün isimlerine link eklenir, kullanıcı tıkladığında o ürüne ait açıklamaların olduğu web sayfasına gider.

Bu işinize yararsa, ilgili kod;

C#:

Sub Test6()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:B" & Rows.Count).ClearContents
Range("A1:B1") = Array("Ürün", "Fiyat")

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
        End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub

.

Haluk · 9 Mart 2023

Başka bir alternatif de; A sütunundaki ürün isimlerine link ekledikten sonra, C sütununa otomatik olarak yerleştirilen "Detay" butonlarına tıklandığında D sütunundaki hücreye ürünün açıklamasını getirmektir.

Böylece, sadece istenen ürünlerin açıklamaları alınmış olur ve Excel fazla yorulmaz....

Bununla ilgili kodlar;

C#:

Sub Test7()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:C" & Rows.Count).ClearContents
Range("A1:C1") = Array("Ürün", "Fiyat", "Detay")

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
     
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    Set HTML = CreateObject("HTMLFILE")
   
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
   
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            On Error GoTo 0
        End If
    Next
End Sub

.

Haluk · 9 Mart 2023

Ürün resimleriyle ilgili olarak da; istenilen ürüne ait "Detay" butonuna tıklandığında D sütunundaki hücreye ürüne ait açıklamayla birlikte, o hücreye "Comment-Açıklama" eklenir ve hücrenin üzerine mouse ile gelindiğinde "Açıklamanın" içerisinde ürünün resmi görüntülenir.

Bununla ilgili kodlar da;

C#:

Sub Test8()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:D" & Rows.Count).ClearContents
Range("D1:D" & Rows.Count).ClearComments
ActiveSheet.Buttons.Delete
Range("A1:D1") = Array("Ürün", "Fiyat", "", "Detay")
Range("A1:D1").Font.Bold = True
Columns("A").ColumnWidth = 50
Columns("B:D").ColumnWidth = 9

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
       
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Private Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    Set HTML = CreateObject("HTMLFILE")
    
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
    
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).innerText)
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            Range("D" & i + 1).WrapText = False
            On Error GoTo 0
        End If
        
        If Divs(x).ID = "product-primary-image" Then
            On Error Resume Next
            Set CommentBox = Range("D" & i + 1).AddComment
            picURL = Replace(Divs(x).getElementsByTagName("img")(0).src, "about:", "https:")
            CommentBox.Shape.Fill.UserPicture (picURL)
            CommentBox.Shape.Width = 100
            CommentBox.Shape.Height = 100
            On Error GoTo 0
        End If
    Next
End Sub

.

Tevfik_Kursun · 10 Mart 2023

Sayın Haluk Hocam,
Muhteşemsiniz, insanda daha neler yapılabilir? sorusunun canlanmasını tetikliyorsunuz. Excel'de ve GoogleDrive tabanlı işlemlerde sizden de çok şey öğrendiğimi biliyorum ve müteşekkirim. Gerçi henüz, destek olmadan internet tabanlı işlemlerde başarılı olamıyorum ama olsun hep destekleyen excel.web.tr ailesinin yanımda olduğunu biliyorum.
akakce.com da kategorileri listelemek istedim ama başarılı olamadım. Daha nerelere dikkat etmem gerektiğini tam kavrayamamışım demek, ama, öğreneceğim!
Saygılarımla

Haluk · 10 Mart 2023

Tevfik Bey, nazik mesajınız için size ve mesajlarda "Beğenisini" ileten herkese teşekkür ederim...

.

Tevfik_Kursun · 10 Mart 2023

Rica ederim
Saygılarımla

Haluk · 13 Mart 2023

serkagkx' Alıntı:
valla hocam uğraştırıyoruz senide ama 1 haftadan fazladır çözüm arıyorum ya 10 dk da çözdük neredeyse

İcimde kalmasin diye yaziyorum........Biz ugrastik ortaya birseyler cikarttik, ama siz zahmet edip bir cevap bile yazmadiniz.

.

ibere · 15 Mart 2023

Haluk' Alıntı:

Ürün resimleriyle ilgili olarak da; istenilen ürüne ait "Detay" butonuna tıklandığında D sütunundaki hücreye ürüne ait açıklamayla birlikte, o hücreye "Comment-Açıklama" eklenir ve hücrenin üzerine mouse ile gelindiğinde "Açıklamanın" içerisinde ürünün resmi görüntülenir.

Ekli dosyayı görüntüle 243502

Bununla ilgili kodlar da;

C#:

Sub Test8()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:D" & Rows.Count).ClearContents
Range("D1:D" & Rows.Count).ClearComments
ActiveSheet.Buttons.Delete
Range("A1:D1") = Array("Ürün", "Fiyat", "", "Detay")
Range("A1:D1").Font.Bold = True
Columns("A").ColumnWidth = 50
Columns("B:D").ColumnWidth = 9

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
      
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Private Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    Set HTML = CreateObject("HTMLFILE")
   
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
   
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).innerText)
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            Range("D" & i + 1).WrapText = False
            On Error GoTo 0
        End If
       
        If Divs(x).ID = "product-primary-image" Then
            On Error Resume Next
            Set CommentBox = Range("D" & i + 1).AddComment
            picURL = Replace(Divs(x).getElementsByTagName("img")(0).src, "about:", "https:")
            CommentBox.Shape.Fill.UserPicture (picURL)
            CommentBox.Shape.Width = 100
            CommentBox.Shape.Height = 100
            On Error GoTo 0
        End If
    Next
End Sub

.

Hocam eline sağlık, şu xmlhttp nesnesini öğrenmek istiyorum fakat detaylı bir rehber bulamadım. Yardımcı olursan sevinirim.

emsey · 18 Mart 2023

Haluk' Alıntı:

Ürün resimleriyle ilgili olarak da; istenilen ürüne ait "Detay" butonuna tıklandığında D sütunundaki hücreye ürüne ait açıklamayla birlikte, o hücreye "Comment-Açıklama" eklenir ve hücrenin üzerine mouse ile gelindiğinde "Açıklamanın" içerisinde ürünün resmi görüntülenir.

Ekli dosyayı görüntüle 243502

Bununla ilgili kodlar da;

C#:

Sub Test8()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:D" & Rows.Count).ClearContents
Range("D1:D" & Rows.Count).ClearComments
ActiveSheet.Buttons.Delete
Range("A1:D1") = Array("Ürün", "Fiyat", "", "Detay")
Range("A1:D1").Font.Bold = True
Columns("A").ColumnWidth = 50
Columns("B:D").ColumnWidth = 9

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
      
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Private Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    Set HTML = CreateObject("HTMLFILE")
   
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
   
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).innerText)
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            Range("D" & i + 1).WrapText = False
            On Error GoTo 0
        End If
       
        If Divs(x).ID = "product-primary-image" Then
            On Error Resume Next
            Set CommentBox = Range("D" & i + 1).AddComment
            picURL = Replace(Divs(x).getElementsByTagName("img")(0).src, "about:", "https:")
            CommentBox.Shape.Fill.UserPicture (picURL)
            CommentBox.Shape.Width = 100
            CommentBox.Shape.Height = 100
            On Error GoTo 0
        End If
    Next
End Sub

.

Vay arkadaş maşallah ya. Kod anlatılmaz yazılır olduğunu defalarca öğrenmiş olduk. Emeğine yüreğine sağlık üstad.

Haluk · 18 Mart 2023

emsey' Alıntı:
Vay arkadaş maşallah ya. Kod anlatılmaz yazılır olduğunu defalarca öğrenmiş olduk. Emeğine yüreğine sağlık üstad.

Eyvallah birader ....

.

serkagkx · 10 Nisan 2023

Hocam tekrardan Merhaba yardımınız için teşekkür ederim, detay butonuna tıklamadan olduğu gibi açıklamalarıda getirebilir miyiz?

Haluk' Alıntı:

Başka bir alternatif de; A sütunundaki ürün isimlerine link ekledikten sonra, C sütununa otomatik olarak yerleştirilen "Detay" butonlarına tıklandığında D sütunundaki hücreye ürünün açıklamasını getirmektir.

Böylece, sadece istenen ürünlerin açıklamaları alınmış olur ve Excel fazla yorulmaz....

Ekli dosyayı görüntüle 243501

Bununla ilgili kodlar;

C#:

Sub Test7()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:C" & Rows.Count).ClearContents
Range("A1:C1") = Array("Ürün", "Fiyat", "Detay")

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
    
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
  
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
  
    Set HTML = CreateObject("HTMLFILE")
  
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
  
    objHTTP.Open "GET", strURL, False
    objHTTP.send
  
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
  
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            On Error GoTo 0
        End If
    Next
End Sub

.

Güncel Market Fiyatları İnternetten Bulmak

Haluk

𐱅𐰇𐰼𐰚

serkagkx

serkagkx

beab05

Özel Üye

Haluk

𐱅𐰇𐰼𐰚

Haluk

𐱅𐰇𐰼𐰚

Haluk

𐱅𐰇𐰼𐰚

Tevfik_Kursun

Haluk

𐱅𐰇𐰼𐰚

Tevfik_Kursun

Haluk

𐱅𐰇𐰼𐰚

ibere

emsey

Haluk

𐱅𐰇𐰼𐰚

serkagkx