Traitement htmlCodePage sur une plage de cellules en VBA

Le 14/01/2022 à 21:00
Bonjour à tous,
Je cherche à faire un traitement sur une plage de cellules en VBA, mais sans réussite :(

En effet, J'ai 2 feuilles :
- Liste: contient list des url (colonne A) avec nombre de resultat colonne B.
- Code Source: importe la code source de la page web
L objectif est de chercher une valeur sur le code source de la page web de l'url en question

J'ai réussi à le faire pour la première cellule (URL 1), mais j'ai du mal à placer la boucle pour lancer la recherche pour un ensemble de liens one shot ( Colonne A de la feuille Liste)
Sub Bouton1_Cliquer()

    Dim L As Worksheet, P As Worksheet, adresse_URL As String, cellule As Range, k As Integer

        Set L = Worksheets("Liste") 'Je définie mon onglet liste par L
    Set C = Worksheets("code source") 'Je définie mon onglet code source par C
    adresse_URL = L.Cells(2, 1) 'L'adresse URL se trouve dans la feuille L (liste), deuxième ligne, première colonne
    codeHtml = htmlCodePage(adresse_URL) 'j'affecte ma variable adresse URL
    Sheets("code source").Activate 'J'active la feuille ou je veux les données
    codeHtml = Split(codeHtml, Chr(10)) 'Division par ligne de code

    For i = 0 To UBound(codeHtml)
        Cells(i + 1, 1) = codeHtml(i)
        Next
         Columns("A:A").Select
    Range("A4").Activate
    Selection.AutoFilter
    Range("B176").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-1],SEARCH(""résultats"",RC[-1],1)-8,15)"
    Range("B176").Select
    Selection.Copy
    Sheets("Liste").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End Sub

Merci d'avance pour votre aide

Le 15/01/2022 à 06:54

Bonjour,

Essayez ceci, non vérifié puisque pas de fichier fourni

Sub Bouton1_Cliquer()
    Dim L As Worksheet, C As Worksheet
    Dim j As Long, i As Long, DerUrl As Long
    Dim CodeHtml As String, Adresse_URL As String

    Application.ScreenUpdating = False
    Set L = Worksheets("Liste") 'Je définie mon onglet liste par L
    Set C = Worksheets("code source") 'Je définie mon onglet code source par C
    DerUrl = L.Range("A" & Rows.Count).End(xlUp).Row
    For j = 2 To DerUrl
        Adresse_URL = L.Cells(2, 1) 'L'adresse URL se trouve dans la feuille L (liste), deuxième ligne, première colonne
        CodeHtml = Adresse_URL 'j'affecte ma variable adresse URL
        CodeHtml = Split(CodeHtml, Chr(10)) 'Division par ligne de code
        For i = 0 To UBound(CodeHtml)
            C.Cells(i + 1, 1) = CodeHtml(i)
        Next
        C.Range("B176").FormulaR1C1 = "=MID(RC[-1],SEARCH(""résultats"",RC[-1],1)-8,15)"
        C.Range("B176").Copy L.Cells(j, 2)
    Next j
    Set L = Nothing
    Set C = Nothing
End Sub

Cdlt

Le 15/01/2022 à 23:15

Bonjour Arturo83,

Merci bcp pour ta réponse,

En effet, j'ai essayé le code proposé, mais je reçois un message d'erreur (erreur de compilation: tableau attendu)

Je met en jointure le fichier source à titre d'exemple

Merci d'avance pour ton aide :)

15extraction-code-sourcev2.xlsm (46.95 Ko)
Le 16/01/2022 à 00:55

reBonjour Arturo83,

J'ai un petit peu modifié ton code, résultat je reçois le resultat du premier URL dupliqué sur toute les lignes :(

Sub Bouton1_Cliquer()
    Dim L As Worksheet, C As Worksheet
    Dim j As Long, i As Long, DerUrl As Long
    Dim adresse_URL As String

    Application.ScreenUpdating = False
    Set L = Worksheets("Liste") 'Je définie mon onglet liste par L
    Set C = Worksheets("code source") 'Je définie mon onglet code source par C
    DerUrl = L.Range("A" & Rows.Count).End(xlUp).Row
    For j = 2 To DerUrl
        adresse_URL = L.Cells(2, 1) 'L'adresse URL se trouve dans la feuille L (liste), deuxième ligne, première colonne
        CodeHtml = htmlCodePage(adresse_URL) 'j'affecte ma variable adresse URL
        CodeHtml = Split(CodeHtml, Chr(10)) 'Division par ligne de code
        For i = 0 To UBound(CodeHtml)
            C.Cells(i + 1, 1) = CodeHtml(i)
        Next
        C.Range("B176").FormulaR1C1 = "=MID(RC[-1],SEARCH(""résultats"",RC[-1],1)-8,15)"
        C.Range("B176").Copy
        L.Cells(j, 2).PasteSpecial Paste:=xlPasteValues

    Next j
    Set L = Nothing
    Set C = Nothing
End Sub

Merci d'avance pour ton aide pour placer correctement la boucle

Fichier en PJ

14extraction-code-source-v3-2.xlsm (54.40 Ko)
Le 16/01/2022 à 04:22

Bonjour,

Oui, il y a eu un petit oubli, remplacez la ligne suivante:

Adresse_URL = L.Cells(2, 1) 'L'adresse URL se trouve dans la feuille L (liste), deuxième ligne, première colonne

par

Adresse_URL = L.Cells(j, 1) 'L'adresse URL se trouve dans la feuille L (liste), deuxième ligne, première colonne

il fallait remplacer le "2" de la ligne par " j".

Cdlt

Le 16/01/2022 à 14:24

Bonjour,

Merci pour votre confirmation,

A ce stade, j'aimerai refaire le traitement pour chaque URL de la liste au lieu de dupliquer le résultat de la première ligne, y-a-til un moyen pour le faire svp ?

Merci pour votre aide

Cordialement

13extraction-code-source-v3-2.xlsm (54.40 Ko)
Le 17/01/2022 à 05:55

Bonjour,

A ce stade, j'aimerai refaire le traitement pour chaque URL de la liste au lieu de dupliquer le résultat de la première ligne, y-a-til un moyen pour le faire svp ?

Mais, je vous ai donné la solution précédemment, dans la ligne suivante, il faut remplacer le 2 de la ligne par j

adresse_URL = L.Cells(2, 1) 'L'adresse URL se trouve dans la feuille L (liste), deuxième ligne, première colonne

après correction, vous devez avoir ceci (j remplace le 2):

adresse_URL = L.Cells(j, 1) 'L'adresse URL se trouve dans la feuille L (liste), deuxième ligne, première colonne.

Cdlt

[s=co-c0504d][/s]

Rechercher des sujets similaires à "traitement htmlcodepage plage vba"