Extraction données web/excel VBA

Résolu/Fermé
Thomas71100
Messages postés
6
Date d'inscription
samedi 14 janvier 2017
Statut
Membre
Dernière intervention
17 janvier 2017
- 14 janv. 2017 à 12:56
Thomas71100
Messages postés
6
Date d'inscription
samedi 14 janvier 2017
Statut
Membre
Dernière intervention
17 janvier 2017
- 17 janv. 2017 à 14:28
Bonjour,

Je connais absolument rien sur VBA (plutôt bricoleur)
Je suis tombé sur la page ci-dessous et la solution proposé réponds parfaitement à mon besoin sauf que je dois l'adapter.

La page en question la voici :
https://forums.commentcamarche.net/forum/affich-25514152-automatiser-extraction-donnees-web-excel-vba
Au passage un grand merci à "eriiic" pour sa contribution et solution .
En résumer le code extrait des données à partir du web sur l'Excel dans la feuille1. une fois le macro activé sur la feuille1 on importe des données sur la feuille2 en haut ou bas des mots de références. et les données recherchés sont recherchés à partir des mots de référence qui se situes sur la même ligne.

le voici le code (lien de la solution proposé par "eriiic" https://www.cjoint.com/c/CCCpj40Y2dj )
---------------------------
Sub MAJ()
Dim i As Long, ws As Worksheet, savbarre As String
Dim c As Range, décalage As String
' mettre Feuil2 en variable pour raccourcir le code et qu'il soit plus lisible
Set ws = Worksheets("Feuil2")
'activer Feuil1 recevant la requête web
Worksheets("Feuil1").Select
Worksheets("Feuil1").[A1].Select
'sauvegarde état barre d'état en bas
savbarre = Application.DisplayStatusBar
' activer barre d'état
Application.DisplayStatusBar = True
derlig = ws.[B65536].End(xlUp).Row
For i = 5 To derlig ' pour chaque ligne d'adresse web
' mettre à jour le n° du site dans la barre d'état
Application.StatusBar = "Site " & i - 4 & "/" & derlig - 4 & " en cours..."
'modifier la requete web
With Selection.QueryTable
'la faire pointer sur la nouvelle adresse
.Connection = "URL;" & ws.Cells(i, 2).Value
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
' mettre à jour les données du site (dans feuil2) à partir des données de la requête
With ws
For col = 3 To .Cells(4, Columns.Count).End(xlToLeft).Column
Set c = Cells.Find(.Cells(4, col), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
décalage = .Cells(3, col)
.Cells(i, col) = c.Offset(Split(décalage, "-")(0), Split(décalage, "-")(1))
Else
.Cells(i, col) = "non trouvé"
End If
Next col
End With
Next i ' site suivant
'
'rétablir l'état de la barre d'état
Application.DisplayStatusBar = savbarre
Set ws = Nothing
End Sub
---------------
Ma question est la suivante (trop facile pour certains mais trop complexe pour moi)
Comment ajouter une fonction(ou variable) dans le code pour pouvoir récupérer toujours le même principe ( de la feuille1 vers la feuille2) une partie de texte d'une cellule ? exemple :
Je cherche à afficher sur la feuille2 ( même principe du code ci-haut) le texte "une voiture bleu" qui se trouve dans une cellule de la feuille1 "couleur du véhicule : une voiture bleu" ?

Merci à vous de votre aide

1 réponse

eriiic
Messages postés
24446
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
17 septembre 2022
7 122
14 janv. 2017 à 22:49
Bonjour,

c'est vague...
Donc l'essentiel, à adapter à ton besoin :
Sub test()
    Dim c As Range, ch As String
    ch = "couleur du véhicule : "    ' respecter accents et majuscules
    Set c = Cells.Find(ch, LookIn:=xlValues, lookat:=xlPart)
    If c Is Nothing Then
        MsgBox "non trouvé"
    Else
        MsgBox Mid(c.Value, Len(ch) + 1)
    End If
End Sub

eric
0
Thomas71100
Messages postés
6
Date d'inscription
samedi 14 janvier 2017
Statut
Membre
Dernière intervention
17 janvier 2017

Modifié par Thomas71100 le 15/01/2017 à 11:26
Bonjour Eric et merci pour ta réponse rapide
Désolé si je me suis mal exprimé. Je vais essayé d'être plus clair avec une copie d'écran
comme tu peux voir sur l'image je cherchais à afficher sur la feuil2 les données entourés de vert et orange de la col C de la feuil1 (feuil1=extraction de donné web)

feuil2
ligne 4 > noms des champs à récupérer
ligne 5 > écriture des données récupérés

Voilà je voulais rester dans la même logique de fonctionnement sauf que je voulais récupérer un morceau de texte d'une cellule dans l'exemple ci-dessous je récupère "(90° = vertical) [°]" dans une cellule qui contient le texte "Angle du forage (90° = vertical) [°] "

J'espère être plus explicite (désolé pas facile pour moi) et merci encore pour ta patience

Exemple requête lancée sur de 2 site web depuis la feuil2
0
eriiic
Messages postés
24446
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
17 septembre 2022
7 122
15 janv. 2017 à 11:27
Bonjour,

C'est un forum excel, pas paint.
cjoint.com et coller ici le lien fourni.
eric
0
Thomas71100
Messages postés
6
Date d'inscription
samedi 14 janvier 2017
Statut
Membre
Dernière intervention
17 janvier 2017
> eriiic
Messages postés
24446
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
17 septembre 2022

15 janv. 2017 à 18:08
oups désolé
voici le lien https://www.cjoint.com/c/GAprf4AG5ws
Autrement pour mon message précédent je n'ai pas la main pour le modifié, je serai pour la prochaine fois.
Thomas.
0
eriiic
Messages postés
24446
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
17 septembre 2022
7 122
Modifié par eriiic le 15/01/2017 à 19:45
C'est un forum excel, pas paint.
Ca veut dire que ton image ne sert à rien.
Il faut le fichier xls, avec tes url (fonctionnelles !!!) à récupérer, quelles données et où.
Parce que là ton image de données c'est celles du site qu'on m'avait demandé, ça m'étonnerait que tu aies le même...
0
Thomas71100
Messages postés
6
Date d'inscription
samedi 14 janvier 2017
Statut
Membre
Dernière intervention
17 janvier 2017
> eriiic
Messages postés
24446
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
17 septembre 2022

17 janv. 2017 à 06:57
Bonjour Eric,
En postant l'image c'était une façon pour moi d’apporter d’élément complémentaire sur ma demande histoire d’être plus clair, désolé d'avoir pollué le forum...
Pour les données url (fonctionnel) en fait ça concerne des données de l'intranet de mon employeur je ne peux en dire + tous ce que je peux dire l'extraction concernent les statuts documentaire (parcours d’approbation chez nous est très long) ;
En effet je reçois un reporting hebdomadaire par un collègue (extraction depuis un logiciel improntu (un truc du genre) et strictement réservé à quelque personne) sauf qu’à chaque fois je dois relancer ou courir derrière.
Donc pendant les vacances de cette personne je m’amuse à rechercher document par document.
Un petit d’exemple de résultats du Requête sur un document : Référence, indice de révision, cause de révision, type documents, langue, Statut, entité de l'auteur, niveau de confidentialité, norme, niveau qualité, contrat, nom de l’approbateur.... (J’ai la possibilité de limiter les critères)
En vue de ces données qui m’intéresse, je dois planifier ma liste de route donc une série d’action (lancement, relance, identification des urgences...) étaler sur deux semaines.
Ton macro fonctionne parfaitement comme je souhaite pour quelque données situé sur la colonne A:B. https://www.cjoint.com/c/GArf32gkTks
D’où ma demande initiale comment extraire une partie du texte comme exemple :
Ligne 8 : Extraire la référence documentaire « ABCDEF12-XYZ0153 » de la cellule qui contient « Référence : ABCDEF12-XYZ0153 »
Nota : dans le fichier .xls . Etant des liens d’intranet de mon employeur, je me dois dans l’obligation de nettoyer le résultat et préserver la confidentialité, désolé.
0