Séparer nom , adresse ,cp ,ville, tel ,url, effectifs

Bonjour,

Avec ça (sur Excel) dans une cellule

Bbbbbbbbb Patrick

Cafés, bars

Localisation22 av Danton, 08500 Revin

Ajouter ce pro aux favoris

Afficher le numéro

Numéro de Téléphone 03 00 00 00 00

03 00 00 00 00

Informations financières et juridiquesOuvrir les annonces légales

Sur l'établissement

SIRET33020373800019

Code NAF5610A

Effectif de l'établissement0 salarié

Je souhaite séparer le nom, adresse, code postal, Ville, numéro de téléphone 1 et 2 s’il y on a,

le lien du site web de la société s’il y on a, mettre OUI s’il y a une url et non au cas contraire, et enfin le nombre de salariés, s’il y a 0 salarié, mettre NA

Je dois faire ça tous les jours

Je débute en vba et souhaite que vous m’aidiez svp,

Je que j’aimerais faire c’est d’un seul clic ça se sépare et prends leurs places

Merci pour votre réponse

Eric

Bonjour, comme tu l'expliques, tu vas dans données et convertir, tu choisis le séparateur que tu utilises, si c'est l'espace, tu laisses standard et tout va se mettre en colonnes. Bien à toi.

bonjour,

savez que vos données contiennent un ASCII-code 10, = linefeed (saut de ligne) qui divise votre texte en plusieurs parties. see A9

En VBA avec split on sait couper in texte comme-cà en plusieurs subtextes et puis ces subtextes peuvent etre coupés plusieurs fois en encore de plus petits morceaux. Comme-çà vous arrivez à vous but. Savez aussi, que quand vous coupez un texte, la première partie a index numéro 0 (!)

Sub teste()
     sp = Split(Range("A9").Value, vbLf)     'il y a un charactère "LINEFEED" (vbLF, saute de ligne) entre chaque partie
     sp1 = Split(Mid(sp(2), 14), ",")     '3ieme partie = location, encore separer sur la virgule
     If UBound(sp1) = 1 Then sp2 = Split(Trim(sp1(1)), " ", 2) Else sp2 = Split(" , ", ",")
     Range("A10").Resize(, 12).Value = Array(sp(0), sp(1), sp1(0), "?", sp2(0), sp2(1), Replace(Mid(sp(4), 24), " ", ""), "?2", "?3", "?4", "?5", "?6")
End Sub

si c'était moins difficile, vous pouviez aussi utiliser "Texttocolumns", mais ici il en faut plus.

ça rapproche du résultat voulu mais avec le numéro de tel ,il y a erreur ,ça ne renvoi pas le numéro ,

et en passant j'aimerais demander comment on fait pour modifier range("A9") par la cellule sélectionné,

désolé car je débute vraiment avec vba

merci

j'aimerais aussi mettre les résultat sur la même

19fichier.xlsx (9.67 Ko)

ligne,

par exemple A1 et mettre les résultat directement sur A1 ,B1,,,,

re,

Sub teste()

     '1ier partie preparation : plus tard vous pouvez effacer ces 2 lignes
     Range("A10").Value = Range("A9").Value     'copier A9 --> A10
     Range("A10").Select

     '2ieme partie : le vrai code
     With ActiveCell     'la cellule sélectionnée pour le moment = point de reference
          MsgBox .Value, , "le contenu de la cellulle " & .Address     'montrer le contenu
          sp = Split(.Value, vbLf)     'il y a un charactère "LINEFEED" (vbLF, saute de ligne) entre chaque partie

          societe = sp(0)
          activite = sp(1)

     'la 3ieme ligne a index numéro 2, elle commence avec localisation = 14 charactères, puis la rue + un virgule + espace + code postal + espace + ville
          sp1 = Split(Mid(sp(2), 14), ",")     '3ieme partie = location, encore separer sur la virgule
          rue = sp1(0)
          If UBound(sp1) = 1 Then sp2 = Split(Trim(sp1(1)), " ", 2) Else sp2 = Split(" , ", ",")     's'il y a un virgule couper le reste après le virgule en 2 parties sur le premier espace
          code_postal = sp2(0)
          ville = sp2(1)
          adr2 = "Adresse2"

          tel1 = Replace(Mid(sp(4), 24), " ", "")
          tel2 = "Telephone2"
          siret = sp(7)
          Url_ = "www...."
          site = "oui/non"
          eff = "???"

          .Resize(, 12).Value = Array(societe, activite, rue, adr2, code_postal, ville, tel1, tel2, siret, Url_, site, eff)     ' à partir du point de reference copiez 12 cellules vers la droite avec ces 12 variables
     End With
End Sub

dans le editeur VBA utilisez F8 pour executer pas à pas la macro et activez aussi la "fenetre variables locaux"

schermafbeelding 2022 05 27 124641

merci beaucoup

par contre avec les trois dernieres ,il y encore erreur

j'utilise ces formules pour ces 3 dernière lignes mais je ne sais pas comment l'utliser avec vba et l'assembler avec le vba ci dessus

=LIEN_HYPERTEXTE(SUBSTITUE(SUBSTITUE(SI(SIERREUR(TROUVE("//";A1;1);FAUX);STXT(C34;TROUVE("http";A34;1);99);"");"Sites et réseaux sociaux";"");CAR(10);"")) Pour l'url

=SI(SIERREUR(TROUVE("//";K1;1);FAUX);"OUI";SI(SIERREUR(TROUVE("à";K1;1);FAUX);"NON";"NON")) Pour SITE

=SUBSTITUE(SUBSTITUE(SUBSTITUE(SUBSTITUE(SUBSTITUE(SI(SIERREUR(TROUVE(" inconnu";A34;1);FAUX);"NA";SI(SIERREUR(TROUVE("à";A34;TROUVE("Eff";A34));FAUX);STXT(A34;TROUVE("Effectif de l'établissement";A1)+27;TROUVE(" à ";A1;TROUVE("Eff";A1))+4);"NA"));"salariés";"");K1;"");"Sites et réseaux sociaux";"");"Typologie de l'établissement";"");CAR(10);"") Pour EFFECTIFS

merci de votre aide

Est-ce que vous pouvez me joindre un fichier avec quelques exemples.

c'est certainement plus facile que ça.

Sub teste()

     '1ier partie preparation : plus tard vous pouvez effacer ces 2 lignes
     Range("A10").Value = Range("A9").Value     'copier A9 --> A10
     Range("A10").Select

     '2ieme partie : le vrai code
     With ActiveCell     'la cellule sélectionnée pour le moment = point de reference
          MsgBox .Value, , "le contenu de la cellulle " & .Address     'montrer le contenu
          sp = Split(.Value, vbLf)     'il y a un charactère "LINEFEED" (vbLF, saute de ligne) entre chaque partie

          societe = sp(0)
          activite = sp(1)

     'la 3ieme ligne a index numéro 2, elle commence avec localisation = 14 charactères, puis la rue + un virgule + espace + code postal + espace + ville
          sp1 = Split(Mid(sp(2), 14), ",")     '3ieme partie = location, encore separer sur la virgule
          rue = sp1(0)
          If UBound(sp1) = 1 Then sp2 = Split(Trim(sp1(1)), " ", 2) Else sp2 = Split(" , ", ",")     's'il y a un virgule couper le reste après le virgule en 2 parties sur le premier espace
          code_postal = sp2(0)
          ville = sp2(1)
          adr2 = "Adresse2"

          tel1 = Replace(Mid(sp(4), 24), " ", "")
          tel2 = "Telephone2"
          siret = sp(7)

          fl = Filter(sp, "http", 1, 1)     'cherche un élément de sp qui contient "http"
          If UBound(fl) = -1 Then     'rien trouvé
               url_ = "-"
          Else
               url_ = Mid(fl(0), fl(0), InStr(1, "http", 1))     'si trouvé, prend le premier element de ce recherche
               MsgBox url_
               url_ = "https://forum.excel-pratique.com/excel/separer-nom-adresse-cp-ville-tel-url-effectifs-172349"
               url_ = Mid(url_, InStr(1, url_, "http", 1))  'si trouvé, prend le premier element de ce recherche
          End If

          site = IIf(url_ = "-", "NON", "OUI")

     'pour les salariés
          eff = "???"
          fl = Filter(sp, "salarié", 1, 1)
          If UBound(fl) > -1 Then eff = Trim(Replace(fl(0), "salarié", "", , , 1))

          .Resize(, 12).Value = Array(societe, activite, rue, adr2, code_postal, ville, tel1, tel2, siret, url_, site, eff)     ' à partir du point de reference copiez 12 cellules vers la droite avec ces 12 variables
          If url_ <> "-" Then .Parent.Hyperlinks.Add Anchor:=.Offset(, 9), Address:=url_, TextToDisplay:="Sites et réseaux sociaux"     'le hyperlink

     End With
End Sub

merci beaucoup ,ça marche bien,

ça m'aide vraiment ,merci

Rechercher des sujets similaires à "separer nom adresse ville tel url effectifs"