Extraction données web/excel VBA
Résolu
Thomas71100
Messages postés
6
Date d'inscription
Statut
Membre
Dernière intervention
-
Thomas71100 Messages postés 6 Date d'inscription Statut Membre Dernière intervention -
Thomas71100 Messages postés 6 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Extraire données site web vers excel
- Création site web - Guide
- Web office - Guide
- Site de telechargement - Accueil - Outils
- Site comme coco - Accueil - Réseaux sociaux
- Extraire une video youtube - Guide
1 réponse
Bonjour,
c'est vague...
Donc l'essentiel, à adapter à ton besoin :
eric
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
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
C'est un forum excel, pas paint.
cjoint.com et coller ici le lien fourni.
eric