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 Subsi 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
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 Subdans le editeur VBA utilisez F8 pour executer pas à pas la macro et activez aussi la "fenetre variables locaux"
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