extraction d'une url

[Leuk]

Bonjour à tous,

J'ai un petit problème sous excel à vous soumettre....
Je récupère dans excel un fichier texte ce qui me donne un feuille avec des plages allant de A1 à A3000 disons....

Dans chaque cellule, j'ai des chaînes de caractères et il faudrait que je récupère dans chacune les url de type < http:..... > quand elles apparaissent et que je les mette dans une autre feuille excel ou dans un autre fichier texte.

Je vous avoue que je patauge beaucoup, vu que je suis plus habitué à bosser sous VBA + Access mais pas avec excel.

Merci d'avance pour votre aide.

 

[RENATO]

Bonjour Leuk,

Une première solution, consiste à définir une zone de critère par exemple dans la première colonne adjacente à tes données dans laquelle tu pourras répertorier les lignes avec des URL.
On imagine que tes données sont en colonne A, une fonction texte type : si(GAUCHE(A1;7)="< http:";VRAI;FAUX) en cellule B1 que tu recopies dans ta colonne B.

Ensuite à l'aide d'un filtre élaboré tu récupères tes lignes qui satisfont aux critère précité dans un autre onglet.

On peut tout à fait envisager de l'automatiser en V.B.

A +

Rénato

 

[michel]

bonsoir Leuk , bonsoir Renato

la macro ci dessous permet d'extraire toutes les Url ( cible sur les mots commençant par "http" ) qui se trouvent dans les chaines de caracteres de la colonne A
comme je ne connais pas le format de ton fichier j'ai essayé de prendre en compte tous les cas de figure dans la cellule
le seul imperatif : que les chaines de caracteres soient séparées par des espaces

Sub ExtraireURL2()
Dim Cell As Range
Dim Place As Byte, Fin As Integer, Debut As String 'à adapter si plus de 256 caracteres par ligne
Dim i As Integer

For Each Cell In Sheets("Feuil1").Range("A1:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
Debut = 1

Do While InStr(Debut, Cell, "http") <> 0

Place = InStr(Debut, Cell, "http")
Fin = InStr(Place, Cell, " ")
i = i + 1

If Place = 0 Then 'si l'url est la premiere chaine de la ligne
Sheets("Feuil2").Cells(i, 1) = Left(Cell, Fin)
Else
Sheets("Feuil2").Cells(i, 1) = Mid(Cell, Place, Fin - Place) 'place les Url dans la feuille 2
End If

Debut = Fin
Loop

Next Cell

End Sub


bonne soiree
MichelXld

 

[Leuk]

Bonsoir à tous,

Je me suis connecté de chez ma copine et malheureusement je n'ai pas mes sources sur moi.

Je vais testez vos suggestions demain matin à la 1ère heure.

Merci pour vos réponses, je vous tiendrai o courant.

Bonne fin de soirée

 

[michel]

rebonsoir

ooouuppsss.....
toutes mes excuses , je me suis trompé de version ....

Sub ExtraireURL3()
Dim Cell As Range
Dim Place As Byte, Fin As Integer, Debut As String 'à adapter si plus de 256 caracteres par ligne
Dim i As Integer

For Each Cell In Sheets("Feuil1").Range("A1:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
Debut = 1
Cell = Cell & " " 'si Url est la derniere chaine de la ligne
Do While InStr(Debut, Cell, "http") <> 0

Place = InStr(Debut, Cell, "http")
Fin = InStr(Place, Cell, " ")
i = i + 1

If Place = 0 Then 'si l'url est la premiere chaine de la ligne
Sheets("Feuil2").Cells(i, 1) = Left(Cell, Fin)
Else
Sheets("Feuil2").Cells(i, 1) = Mid(Cell, Place, Fin - Place) 'place les Url dans la feuille 2
End If

Debut = Fin
Loop

Next Cell

End Sub


bonne soiree
MichelXld

 

[Leuk]

Salut Michel & renato

je viens de m'y mettre et j'ai testé le script de Michel, malheureusement il t'a un bug dès la 1ère boucle " For Each cell...."

J'ai mis en pièces jointes un bout de fichier excel pour que vous voyez la tête que ça a.

Je m'y remets de mon coté.

Merci d'avance et à plus tard

 

[Leuk]

re bonjour,

Finallement ton script était bon Michel... c moi qui ai fait une erreur en le tapant.

Merci encore à toi et Renato pour vos réponses.

Bonne journée

@+

 

[Leuk]

Bonjour,

ah la la ces URL......
Le script marche presque comme je veux, j'esssaye de le modifier car il faut qu'il ne renvoit que l'URl avec http://.....org ou .com ou .net etc.... et rien d'autre après.

Merci d'avance pour votre aide.

 

[michel]

bonjour Leuk

peux tu placer sur le forum un exemple zippé contenant quelques données et le résultat souhaité , car je ne comprends plus ce que tu cherches à faire


bonne soiree
MichelXld

 

[Leuk]

bonsoir Michel

Alors tu trouveras en fichier joint sur la feuille1 un exemple de lignes que je récupère dans excel et dans la feuille 2 tu verras le résultat que j'obtiens grâce à ton script.

J'ai légèrement modifié ton script.... Cependant lors de l'exécution g un message d'erreur:

" argument ou appel de procédure incorrect"

au débogage il correspond à la ligne du Else sheets.....

Voilou.... j'y travaille encore

Merci d'avance.

Ps: voila le script modifié:

Dim Cell As Range
Dim Place As Byte, Fin As Integer, Debut As String 'à adapter si plus de 256 caracteres par ligne
Dim i As Integer

For Each Cell In Sheets("Feuil1").Range("A1:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
Debut = 1
Cell = Cell & " " 'si Url est la derniere chaine de la ligne
Do While InStr(Debut, Cell, "www") <> 0

Place = InStr(Debut, Cell, "www")
Fin = InStr(Place, Cell, "/")
i = i + 1

If Place = 0 Then 'si l'url est la premiere chaine de la ligne
Sheets("Feuil2").Cells(i, 1) = Left(Cell, Fin)
Else
Sheets("Feuil2").Cells(i, 1) = Mid(Cell, Place, Fin - Place) 'place les Url dans la feuille 2
End If

Debut = Fin
Loop

Next Cell

End Sub

 

[michel]

bonsoir Leuk

comme je l'avais précisé dans mon premier message :
"le seul imperatif : que les chaines de caracteres recherchées soient séparées par des espaces"

ce qui n'est pas le cas de tes données . Je sèche sur ton probleme car je ne trouve pas de logique qui permettrait , sans créer une usine à gaz , de déterminer la fin des chaines à extraire


bonne journée
MichelXld

 

[Leuk]

Bonjour Michel,

Beh moi aussi g planché dessus et c cho. Mais bon à partir du prog que tu as élaboré j'ai fait des petites modifs et ça marche à peu près.

Merci pour tout et bonne journée.