Récupération de données sur une ligne pleine d'informations

Bonjour à tous,

dans le cadre de mon travail j'effectue une étude de marché au sujet des domaines de chasse. Pour cela j'ai scrappé un site internet dans le but de récolter des données bien précises à ce sujet. Je souhaite relever l'ensemble des liens des sites internet, des numéros de téléphones ainsi que du code postal de différents domaine de chasse.

Lorsque j'ai effectué mon scrapp j'ai un fichier excel qui se sépare en deux colonnes : Colonne A avec tous les noms de domaines de chasse resencer en France et la colonne B une ligne pleine d'informations.

Je fais alors appel a vous pour que vous puissiez m'aider à trouver une solution/formule me permettant de relever sur ce grand nombre d'infos exclusivement les données qui m'intéressent soient : numéro de tel, code postal, ainsi que leur site internet (si il y a)

Ci-joint un exemple de fichier avec quelques lignes pour illustrer mes propos.

Vous remerciant par avance de votre aide je vous souhaite une bonne fin de journée ! :)

Bonjour

Pas sûr que le site l'autorise...

Une approche PowerQuery

Bonjour,

Je vous remercie pour votre réponse cependant, je ne maitrise absolument pas l'approche PowerQuery ...

Il y aurait-il une autre solution ?

Cordialement.

Bonjour,

Un exemple en VBA

Sub ConvertRange()
    Dim i As Long

    ' On nettoie les données (caractères de saut de ligne et tabulation
    For i = 1 To 7
        Cells(i, "C") = NettoyerTexte(Cells(i, "B").Text)
    Next i

    ' On sépare le texte par colonne en fonction du séparteur "|"
    Range("C1:C7").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End Sub

Private Function NettoyerTexte(sText As String) As String
    Dim bIs10 As Boolean, bMobile As Boolean, sNewText As String
    Dim iMobile As Long, x As Long, y As String, a As Long

    For x = 1 To Len(sText)
        y = Mid(sText, x, 1)
        Select Case Asc(y)
            Case 10
                If Not bIs10 Then bIs10 = True
                a = a + 1
                If a = 5 Then bMobile = True
            Case 9

            Case Else
                sNewText = sNewText & IIf(bIs10 And bMobile, "|" & y, y)
                bIs10 = False: a = 0
        End Select
    Next x
    NettoyerTexte = sNewText
End Function

Pas certain que cela soit efficace à 100% car les données sont différentes d'une ligne à l'autre, par exemple en ligne 3, il n'y a pas l'indication Mobile, j'ai dû adapter en fonction du jeu de test.

Benead