Récup de donner spécifique dans une page web spécifique.

[neolilous]

Salut à tous. alors voila mon/mes problèmes

Je suis ultra débutant dans le codage et je suis persuadé de l'aide importante qu'il peut fournir.

Donc l'idée est que je voudrait faire un code qui permette de rechercher dans une page web une cellule donnée et l'extraire pour l'insérer dans une cellule d'un fichier excel déjà existant.
Pour ça je sais qu'il y a la fonction extraire des données à partir du web mais ça m'extrait tout un tableau et pas qu'une cellule.

Ensuite cette recherche j'aimerai l'automatiser pour tout mon tableau excel en sachant que:
-pour chaque ligne de mon tableau, l'info que je cherche est dans une page web différente.
-la page web où je veux extraire une donnée pour une ligne contient le nom d'une cellule de la ligne en question.

Je m'explique avec des exemples parceque c'est chaud à expliquer/comprendre je pense...

donc je cherche des informations sur des gènes qui existe sur une page web sur le net:
ex: pour le gène "cg9042" aussi appelé "FBgn0001128"
si on va sur FlyBase Homepage et qu'on recherche le gène on tombe sur une page web appelée : FlyBase Gene Report: Dmel\Gpdh et c'est sur cette page que je voudrais genre juste le "name" et la "summary information"

ici c'est un exemple mais j'en ai plus de 16000 donc autant dire j'oublie toutes recherche manuelle.

donc deja, à part si quelqu'un sait me répondre à tout ça en meme temps, comment on fait pour que:
a b
1 FBgn0001128 rechercher dans FlyBase Gene Report: Dmel\Gpdh
2 etc
3 ...

merci d'avance!

 

[gilbert_RGI]

Re : Récup de donner spécifique dans une page web spécifique.

Bonjour

est-ce que c'est la demande?

 

[gilbert_RGI]

Re : Récup de donner spécifique dans une page web spécifique.

voilà avec le "summary information"

ça devrait fonctionner si les infos se trouvent à la même place sur chaque page web

malheureusement en changeant de page on peut voir que le "summary information" n'est pas à la même place
il faut modifier ici

If i = 10 Then

mais sur 16000 pages

voir essai

nouvelle version
exemples à mettre dans le combo "position"
pour 1123 mettre sur 12
pour 1124 mettre sur 12
pour 1125 mettre sur 12
pour 1126 mettre sur 10
pour 1127 mettre sur 10
pour 1128 mettre sur 12
pour avoir le "summary"

 

[neolilous]

Re : Récup de donner spécifique dans une page web spécifique.

salut, merci de ta réponse. Entre temps j'ai bidouillé un truc qui est peut etre un peu long mais ça marche. La il est entrain de tourner (et oui 16000 lignes c'est lourd) donc le pc où j ai le script est inutilisable pour l'instant. quand c'est fini je te montre mon script pour s'il y a moyen de le raccourcir. (c'est fait a partir de bout de script chopper ici et la donc autant ya un peut des truc qui servent a rien)

 

[neolilous]

Re : Récup de donner spécifique dans une page web spécifique.

bon voila le script un peu long mais efficace.



Sub ObtentionFBgn()

Sheets("ListeFBgn v3").Select
ActiveCell.Offset(1, 0).Range("A1").Select



w = "URL;http://flybase.org/reports/" & ActiveCell.Value

x = ActiveCell.Row
y = ActiveCell.Column
If ActiveCell = Empty Then Exit Sub
If (x / 25) = Int(x / 25) Then
Application.DisplayAlerts = False
ActiveWorkbook.Save
'ActiveWorkbook.Close
'Workbooks.Open Filename:= _
' "H:\CROZATIER-VINCENT_Commun Equipe\ModENCODE\dataS13v4.xlsm", UpdateLinks _
' :=0
Application.DisplayAlerts = True
End If
'import CG+Nom à partir de FB
ActiveWorkbook.Worksheets.Add before:=Worksheets(1)

With ActiveSheet.QueryTables.Add(Connection:= _
w, Destination:=Range("$A$1") _
)
.Name = "nom"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """top_table"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

'copier/coller
Sheets(1).Select
With Sheets(1)

'si rien d'extrait
If ActiveCell = "" then goto suite
'Résumé
Sheets("ListeFBgn v3").Cells(x, y + 1) = Sheets(1).Cells(Cells.Find(What:="Automatically generated summary", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row, Cells.Find(What:="Automatically generated summary", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Column)

'Annotation Symbol
Sheets("FBgn").Cells(x, y + 2) = Sheets(1).Cells(Cells.Find(What:="Annotation symbol", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row, Cells.Find(What:="Automatically generated summary", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Column)

End With

suite:

Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True


Call ObtentionFBgn
End Sub