Extraire l'intérieur d'une table VBA

Bonjour,

ajoute la l'instruction qui se trouve entre '------------------------

Sub queryweb()
'
' via tools, référencer Microsoft HTML object library et Microsoft Internet control

    Dim ie As InternetExplorer, doc As HTMLDocument, ql As Variant, qlq As Variant

    Set ie = CreateObject("InternetExplorer.application")
    ' nom du produit en colonne A (1)
    ' url en colonne 2(B), à partir de la ligne 2
    ie.Visible = False
    dl = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To dl
        qurl = Cells(i, 2)
        Application.StatusBar = "lancement de la requête sur " & qurl

        ie.navigate qurl

        Do
            DoEvents
            Application.StatusBar = "lancement de la requête sur " & qurl & " en attente de la réponse "
        Loop Until ie.readyState = 4
        Application.StatusBar = "réponse reçue pour la requête " & qurl
        Set doc = ie.document
        r = doc.body.innerHTML
        tos = "<DIV class=tr-price-primary itemprop=""price"">"
        ' <DIV class=tr-price-primary itemprop="price">
        s = InStr(r, tos)
        If s <> 0 Then
            tos1 = "</DIV>"
            s1 = InStr(s, r, tos1)
            If s1 <> 0 Then
                prix = Replace(Mid(r, s + Len(tos), s1 - s - Len(tos)), " €", "")
'-----------------------------------------------
                prix = Replace(prix, ".", "")
'-----------------------------------------------
                Cells(i, 3) = prix
                Application.StatusBar = "prix trouvé dans la réponse " & prix
            Else
                Cells(i, 3) = "prix non trouvé"
                Application.StatusBar = tos1 & " non trouvé dans la réponse"
            End If
        Else
            Cells(i, 3) = "prix non trouvé"
            Application.StatusBar = tos & " non trouvé dans la réponse "
        End If
    Next i

    ie.Application.Quit

End Sub

salut,

merci infiniment h2so4 ça marche à merveille. Quelle connaissance!!!!

Une autre petite question si tu veux bien.

Y a t-il la possibilité de lancer la macro à partir d'une ligne précisément sans changer le code.

Je m'explique pour éviter de tout rescanner mes 2000 lignes. Juste si je peux commencer à exécuter la macro a partir d'une ligne précise.

Merci

bonjour,

remplacer le 2 par ton numéro de ligne dans l'instruction

For i = 2 To dl

tu peux le remplacer par la référence à une cellule de ta feuille dans laquelle tu mets le numéro de ligne par exemple en G1. tu y remplis le numéro de ligne puis tu lances la macro.

Sub queryweb()
'
' via tools, référencer Microsoft HTML object library et Microsoft Internet control

    Dim ie As InternetExplorer, doc As HTMLDocument, ql As Variant, qlq As Variant

    Set ie = CreateObject("InternetExplorer.application")
    ' nom du produit en colonne A (1)
   ' url en colonne 2(B), à partir de la ligne 2
   ie.Visible = False
    dl = Range("A" & Rows.Count).End(xlUp).Row
'------------------
pl=range("G1")
if pl="" then pl=2
'---------------------
    For i = pl To dl
        qurl = Cells(i, 2)
        Application.StatusBar = "lancement de la requête sur " & qurl

        ie.navigate qurl

        Do
            DoEvents
            Application.StatusBar = "lancement de la requête sur " & qurl & " en attente de la réponse "
        Loop Until ie.readyState = 4
        Application.StatusBar = "réponse reçue pour la requête " & qurl
        Set doc = ie.document
        r = doc.body.innerHTML
        tos = "<DIV class=tr-price-primary itemprop=""price"">"
        ' <DIV class=tr-price-primary itemprop="price">
       s = InStr(r, tos)
        If s <> 0 Then
            tos1 = "</DIV>"
            s1 = InStr(s, r, tos1)
            If s1 <> 0 Then
                prix = Replace(Mid(r, s + Len(tos), s1 - s - Len(tos)), " €", "")
'-----------------------------------------------
               prix = Replace(prix, ".", "")
'-----------------------------------------------
               Cells(i, 3) = prix
                Application.StatusBar = "prix trouvé dans la réponse " & prix
            Else
                Cells(i, 3) = "prix non trouvé"
                Application.StatusBar = tos1 & " non trouvé dans la réponse"
            End If
        Else
            Cells(i, 3) = "prix non trouvé"
            Application.StatusBar = tos & " non trouvé dans la réponse "
        End If
    Next i

    ie.Application.Quit

End Sub

au top du top !!

Encore merci

A bientôt