Sujet Précédent Sujet Suivant

Import Web copier occurrences multiples

Résolu/Fermé
Leghe59 Messages postés 34 Date d'inscription mercredi 14 juin 2017 Statut Membre Dernière intervention 17 avril 2021 - Modifié le 16 avril 2021 à 17:21
Leghe59 Messages postés 34 Date d'inscription mercredi 14 juin 2017 Statut Membre Dernière intervention 17 avril 2021 - 17 avril 2021 à 17:11
Hello la Team,

Je cherche à récupérer automatiquement des liens de livres en provenance des ces pages :
https://www.decitre.fr/livres/loisirs-nature-voyages/recits-de-voyage.html

J'ai donc créé un classeur à 2 feuilles : EXPORT avec en colonne A la pagination et en colonne B le "réceptacle" des liens, et une feuille TEMP pour récupérer les données de l'URL appelée.
Cette petite macro ne fonctionne qu'à moitié, dans le sens où dès qu'elle trouve un lien, elle passe à la PAGE suivante, sans se préoccuper des liens qui suivent : 

Sub IMPORTURLDECITRE()
    Dim ISBN As String
    Derlig = Sheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row
    For compteur = 2 To Derlig
        PAGE = Sheets("EXPORT").Cells(compteur, 1)
        Sheets("TEMP").Cells.Clear
        Application.CutCopyMode = False
        With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://www.decitre.fr/livres/loisirs-nature-voyages/recits-de-voyage.html?p=" & PAGE _
            , Destination:=Sheets("TEMP").Range("$A$1"))
            .Name = PAGE
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
 Derlig2 = Sheets("TEMP").Range("A" & Rows.Count).End(xlUp).Row
        With Sheets("TEMP")
  For compteur2 = 2 To Derlig2
              Set Col_A = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
              URL = Application.CountIf(Col_A, "*Commander Ajouter au panier Ajouter à ma liste*")
              If URL > 0 Then
                  Lig = 1
                  Lig = .Columns("A").Find("Commander Ajouter au panier Ajouter à ma liste", .Cells(Lig, "A"), , xlPart).Row
                
                  Sheets("EXPORT").Cells(compteur, 2) = Sheets("TEMP").Cells(Lig + 1, 1).Hyperlinks(1).Address
                  Sheets("EXPORT").Cells(compteur, 2).Interior.ColorIndex = 4
              Else
                  Sheets("EXPORT").Cells(compteur, 2) = "inconnu"
                  Sheets("EXPORT").Cells(compteur, 2).Interior.ColorIndex = 3
              End If
          End With
  Next
    Next
End Sub


Où ai-je pêché ?
Et, cerise sur le gâteau, récupérer le 1er livre de chaque page, qui n'a pas en Lig-1 le repère "Commander Ajouter au panier Ajouter à ma liste"

Merci d'avance,

LeGhe
A voir également:

6 réponses

Réponse 1 / 6
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 Ambassadeur 1 557
16 avril 2021 à 19:54
bonjour,
en testant comme je pouvais ton code, je me demande si ton analyse est correcte.
tu écris "dès qu'elle trouve un lien, elle passe à la PAGE suivante, sans se préoccuper des liens qui suivent"
je pense que la macro fait autre chose: chaque fois qu'elle trouve un lien, elle le copie vers le réceptacle prévu, sur la ligne correspondant à la page, en écrasant, bien sûr, le(s) lien(s) éventuellement sauvé(s) précédemment.
0
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557
16 avril 2021 à 20:07
en fait, c'est pire que cela:
ta boucle avec compteur2 fait exactement la même chose à chaque itération, comme tu n'y utilises pas compteur 2 ni ne fait rien qui "progresse" dans les données.
c'est, donc, en effet, le premier lien qui est recopié à chaque fois.

ce code est donc sérieusement défectueux.

le moment me semble donc venu de partager un fichier avec en TEMP les données récupérées du site, et en EXPORT un exemple parlant du résultat attendu.
0
Réponse 2 / 6
Leghe59 Messages postés 34 Date d'inscription mercredi 14 juin 2017 Statut Membre Dernière intervention 17 avril 2021
Modifié le 17 avril 2021 à 11:32
Bonjour, et merci.
La macro doit récupérer 6074 URL sur 304 pages.
Donc colonne A de 1 à 304, et colonne B au final de 1 à 6074.
L'exemple joint ne prend en compte que la 1ère URL de chaque page en "passant au-dessus" des 19 autres (à partir de la ligne 365 de la feuille TEMP)

https://www.cjoint.com/c/KDrjAKgaZip
0
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557
17 avril 2021 à 13:15
je pense que ceci fonctionnera mieux: 
Option Explicit

Sub IMPORTURLDECITRE()
Dim ISBN As String
Dim Derlig, compteur, Derlig2, compteur2, Page, Col_A, URL, Lig, ligdest As Long
Derlig = Sheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row
ligdest = 2
For compteur = 2 To Derlig
      Page = Sheets("EXPORT").Cells(compteur, 1)
      Sheets("TEMP").Cells.Clear
      Application.CutCopyMode = False
      With Sheets("TEMP").QueryTables.Add(Connection:="URL;https://www.decitre.fr/livres/loisirs-nature-voyages/recits-de-voyage.html?p=" & Page _
          , Destination:=Sheets("TEMP").Range("$A$1"))
          .Name = Page
          .FieldNames = True
          .RowNumbers = False
          .FillAdjacentFormulas = False
          .PreserveFormatting = False
          .RefreshOnFileOpen = False
          .BackgroundQuery = True
          .RefreshStyle = xlInsertDeleteCells
          .SavePassword = False
          .SaveData = True
          .AdjustColumnWidth = True
          .RefreshPeriod = 0
          .WebSelectionType = xlEntirePage
          .WebFormatting = xlWebFormattingAll
          .WebPreFormattedTextToColumns = True
          .WebConsecutiveDelimitersAsOne = True
          .WebSingleBlockTextImport = False
          .WebDisableDateRecognition = False
          .WebDisableRedirections = False
          .Refresh BackgroundQuery:=False
    End With
    Derlig2 = Sheets("TEMP").Range("A" & Rows.Count).End(xlUp).Row
    For compteur2 = 2 To Derlig2
        If Sheets("TEMP").Cells(compteur2, 1) = "Commander Ajouter au panier Ajouter à ma liste" Then
            Sheets("EXPORT").Cells(ligdest, 2) = Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks(1).Address
            Sheets("EXPORT").Cells(ligdest, 2).Interior.ColorIndex = 4
            ligdest = ligdest + 1
        End If
    Next compteur2
Next compteur
End Sub
0
Réponse 3 / 6
Leghe59 Messages postés 34 Date d'inscription mercredi 14 juin 2017 Statut Membre Dernière intervention 17 avril 2021
17 avril 2021 à 14:52
Merci infiniment, je comprends mieux mon erreur !

cela dit il y a une erreur d'execution 9 : l'indice n'appartient pas à la selection lors du changement de page :

Sheets("EXPORT").Cells(ligdest, 2) = Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks(1).Address
0
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557
17 avril 2021 à 14:59
examine la valeur de compteur2 au moment de l'erreur, et regarde ce que contient la cellule à la ligne suivante.
0
Réponse 4 / 6
Leghe59 Messages postés 34 Date d'inscription mercredi 14 juin 2017 Statut Membre Dernière intervention 17 avril 2021
17 avril 2021 à 15:16
compteur 2 = 749
ligne suivante : Commander Ajouter au panier Ajouter à ma liste
MAIS sans hyperlink dessous car dernier de la page
0
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557
17 avril 2021 à 15:38
que contient la ligne sans hyperlink?
que faut-il faire dans ce cas-là?
0
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557 > yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024
17 avril 2021 à 15:39
peut-être suffit-il d'ajouter 
-1
en fin de ligne 36.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
Leghe59 Messages postés 34 Date d'inscription mercredi 14 juin 2017 Statut Membre Dernière intervention 17 avril 2021
17 avril 2021 à 16:01
La ligne sans hyperlink est "Trier par".
Le -1 ne fonctionne pas.
Comment lui faire comprendre de stopper quand il trouve le DEUXIEME "Trier par" ?
0
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557
17 avril 2021 à 17:06
ne suffit-il pas alors de tester si un hyperlien est présent? 
    For compteur2 = 2 To Derlig2
        If Sheets("TEMP").Cells(compteur2, 1) = "Commander Ajouter au panier Ajouter à ma liste" Then
            If Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks.Count > 0 Then
                Sheets("EXPORT").Cells(ligdest, 2) = Sheets("TEMP").Cells(compteur2 + 1, 1).Hyperlinks(1).Address
                Sheets("EXPORT").Cells(ligdest, 2).Interior.ColorIndex = 4
                ligdest = ligdest + 1
            End If
        End If
    Next compteur2
0
Réponse 6 / 6
Leghe59 Messages postés 34 Date d'inscription mercredi 14 juin 2017 Statut Membre Dernière intervention 17 avril 2021
17 avril 2021 à 17:11
Vous êtes formidable ! Grand merci...
0

Discussions similaires

Web-DL, Webrip : ça veut dire quoi ?
coeur83 -
Timedodger -

21 réponses