Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Décortiquage et manipulation

Décortiquage et manipulation

24 réponses
Avatar
rthompson
Bonjour à toutes et tous

Et voici un petit casse-tête pour vous

Dans ma colonne A j'ai une addresse de format irrégulier
Et je devrais pour eb extraire les parties pour en faire une liste plus
constante

Et comme un petit dessin faut mieux qu'un long discours
je vous ai mis une petite sélection en pièce jointe

Les questions sont (entre-autres)
y a-t-il une astuce pour trouver dans une cellule les chiffres
et les extraire puis les mettre dans une autre colonne?

Peut-on (et là je sais que c'est possible) retirer tout ce qui suit une
chaîne définie
Par exemple ce qui suit ZI doit aller ailleur

Et puis j'ai oublie comment faire pour que le premier charactère deviennent
une majescule
Mais cela je dois pouvoir le retrouver tout seul

J'ai une liste de plus de 10.000 lignes à ré-arranger pour demain ;-((((((

A bientôt

Rex

http://www.cijoint.fr/cjlink.php?file=cj200807/cijgKSw3lp.xls
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
rthompson
Bonjour et merci

Comme je viens de le signaler
je dois absolument m'absenter

Je te recontacte tantôt

Rex

"FFO" a écrit dans le message de news:

Salut à toi

Je te propose ce code
Le résultat dans les 2 colonnes adjacentes (B et C)

For Each c In Worksheets("Sheet1").Range("A3", "A" &
Range("A65535").End(xlUp).Row)
Caractères = " éèà,"
For i = 1 To Len(c)
A = UCase(Mid(c, i, 1))
If "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Like "*" & UCase(Mid(c, i, 1)) & "*" And
Mid(c, i, 1) <> "-" Then
Nom = Nom & Mid(c, i, 1)
Else
If Caractères Like "*" & Mid(c, i, 1) & "*" = False And Mid(c, i, 1) <>
"-"
Then
Chiffre = Chiffre & Mid(c, i, 1)
End If
End If
If Caractères Like "*" & Mid(c, i, 1) & "*" And Mid(c, i, 1) <> "," Then
Nom = Nom & Mid(c, i, 1)
End If
If "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Like "*" & UCase(Mid(c, i + 1, 1)) & "*"
And
Mid(c, i, 1) = "-" Then
Nom = Nom & Mid(c, i, 1)
Else
If Mid(c, i, 1) = "-" Then
Chiffre = Chiffre & Mid(c, i, 1)
End If
End If
Next
c.Offset(0, 1) = Nom
c.Offset(0, 2) = Chiffre
Nom = ""
Chiffre = ""
Next


Sur ce lien ton fichier avec la macro Traitement

http://www.cijoint.fr/cjlink.php?file=cj200807/cijk0u8uin.xls

Fais des essais et dis moi !!!


"rthompson" wrote:

Encore une fois

Il s'agit d'un "Cadeau" d'une personne ayant quitté la société

Dans Filemaker, il n'avait rien de spécifique pour les addresse et chacun
y
mettait ce qu'il voulait

Maintenant que je suis parvenu à les convaincre d'utilser Act (no pub
please)
et que nous mettons en place une structure et des formats spécifiques
cela devrait aller beaucoup mieux
En ce qui concerne les anciennes entrées, la réaction est simple

Oh, that's not a problem, just ask Rex to sort things out


Donc voilà l'apprenti dans la cadoue

Parce que je te signale, que cette colonne n'en est qu'une
J'en ai une "Floppée" d'autre à régler
Et j'avance pas mal

Mais ici, je coince totalement
Et je me vois mal en rectifier environ 10.000 à la main

A bientôt

Rex




"Modeste" a écrit dans le message de news:
%
Bonsour® Daniel.C avec ferveur ;o))) vous nous disiez :

> En suppposant que les nombres soient toujours en tête.
> En A1 : 100 aaa ZI www
> Pour extraire le nombre :
> =CNUM(GAUCHE(A1;TROUVE(" ";A1)-1))
> pour extraire la partie centrale :
> =STXT(A1;TROUVE(" ";A1)+1;TROUVE("ZI";A1)-TROUVE(" ";A1)-2)
> Pour extraire la chaîne se trouvant après ZI :
> =STXT(A1;TROUVE("ZI";A1)+3;9^9)

:-(
pas si simple que cela ...
selon l'exemple fourni par T.Rex !!!!

comment differencier /isoler :
ZI Rennes Sud-Est (ZI Rennes Sud-Est - 10 rue du Breil) (ZUP ZAC
etc...)
BP 93035 (Rue de la Halte BP 93035) ( Cedex Cidex etc...)
CP 7289 (Pont Bessières, 3 CP 7289)
ces 2 derniers incorporent de plus un saut de ligne

les adresses dont le numéro de voie est à la fin (Rue Despourrins, 6-8)
de
celles ou il est au début (99, rue de l'Abbé Groult)
les adresses ou il n'y a pas de séparateur commun (89 av. Charles de
Gaulle)
ou il n'y a pas de numero de voie (Mas de Grille)
ou les numéro de voie sont composites ( 17-21 , 22 ter)
les noms de voie numérique (rue du 11 novembre 1918)

une solution possible serait de faire un tri des toutes ces adresses
- les regrouper par type de libellé
- séparer dans des feuilles séparées chaque type pour y appliquer un
données
> convertir : adéquat
- un bonne petites dizaines de procs distinctes
- pas mal de manips à la main (inversions, remise en place de colonne)
- certainement pas mal de controle et correction aprés coup
- puis remettre tout en commun...
;o)))


:-(
mais je ne vois pas de procédure simple et universelle

Tu vois Rex, pour faire un parallele avec le suivi de commande (on avait
oublié le conditionnement ;o))).
Ici c'est la collectage correct des adresses qui conditionne tout ce qui
suit...
;o)))

--
@+
;o)))







Avatar
rthompson
Bonjour et merci

A toi aussi je te signale que je dois absolument m'absenter
je te recontacte taontôt

Merci

Rex


"Daniel.C" a écrit dans le message de news:

Pour dégrossir le problème, voici une macro qui lit les adresses en
colonne A, et ventile la rue en colonne B et les numéros en colonne C. Les
cellules non traitées sont coloriées en jaune. Elle n'est pas infaillible,
mais, bon, c'est toujours autant de traité.

Sub test()
Dim c As Range, Adr, txt, rue() As String
Columns.NumberFormat = "@"
For Each c In Range([A3], [A65536].End(xlUp))
Adr = Split(Replace(c, ",", ""))
If IsNumeric(Replace(Adr(0), "-", "")) Then
c.Offset(, 2) = CStr(Adr(0))
ReDim rue(UBound(Adr) - 1)
For i = 1 To UBound(Adr)
rue(i - 1) = Adr(i)
Next i
c.Offset(, 1) = Join(rue, " ")
ElseIf IsNumeric(Replace(Adr(UBound(Adr)), "-", "")) Then
c.Offset(, 2) = Format(Adr(UBound(Adr)), "@")
ReDim rue(UBound(Adr) - 1)
For i = 0 To UBound(Adr) - 1
rue(i) = Adr(i)
Next i
c.Offset(, 1) = Join(rue, " ")
Else
c.Interior.ColorIndex = 6
End If
Next c
End Sub

Daniel
"rthompson" a écrit dans le message de
news:
Encore une fois

Il s'agit d'un "Cadeau" d'une personne ayant quitté la société

Dans Filemaker, il n'avait rien de spécifique pour les addresse et chacun
y mettait ce qu'il voulait

Maintenant que je suis parvenu à les convaincre d'utilser Act (no pub
please)
et que nous mettons en place une structure et des formats spécifiques
cela devrait aller beaucoup mieux
En ce qui concerne les anciennes entrées, la réaction est simple

Oh, that's not a problem, just ask Rex to sort things out


Donc voilà l'apprenti dans la cadoue

Parce que je te signale, que cette colonne n'en est qu'une
J'en ai une "Floppée" d'autre à régler
Et j'avance pas mal

Mais ici, je coince totalement
Et je me vois mal en rectifier environ 10.000 à la main

A bientôt

Rex




"Modeste" a écrit dans le message de news:
%
Bonsour® Daniel.C avec ferveur ;o))) vous nous disiez :

En suppposant que les nombres soient toujours en tête.
En A1 : 100 aaa ZI www
Pour extraire le nombre :
=CNUM(GAUCHE(A1;TROUVE(" ";A1)-1))
pour extraire la partie centrale :
=STXT(A1;TROUVE(" ";A1)+1;TROUVE("ZI";A1)-TROUVE(" ";A1)-2)
Pour extraire la chaîne se trouvant après ZI :
=STXT(A1;TROUVE("ZI";A1)+3;9^9)



:-(
pas si simple que cela ...
selon l'exemple fourni par T.Rex !!!!

comment differencier /isoler :
ZI Rennes Sud-Est (ZI Rennes Sud-Est - 10 rue du Breil) (ZUP ZAC
etc...)
BP 93035 (Rue de la Halte BP 93035) ( Cedex Cidex etc...)
CP 7289 (Pont Bessières, 3 CP 7289)
ces 2 derniers incorporent de plus un saut de ligne

les adresses dont le numéro de voie est à la fin (Rue Despourrins, 6-8)
de celles ou il est au début (99, rue de l'Abbé Groult)
les adresses ou il n'y a pas de séparateur commun (89 av. Charles de
Gaulle)
ou il n'y a pas de numero de voie (Mas de Grille)
ou les numéro de voie sont composites ( 17-21 , 22 ter)
les noms de voie numérique (rue du 11 novembre 1918)

une solution possible serait de faire un tri des toutes ces adresses
- les regrouper par type de libellé
- séparer dans des feuilles séparées chaque type pour y appliquer un
données
> convertir : adéquat
- un bonne petites dizaines de procs distinctes
- pas mal de manips à la main (inversions, remise en place de colonne)
- certainement pas mal de controle et correction aprés coup
- puis remettre tout en commun...
;o)))


:-(
mais je ne vois pas de procédure simple et universelle

Tu vois Rex, pour faire un parallele avec le suivi de commande (on avait
oublié le conditionnement ;o))).
Ici c'est la collectage correct des adresses qui conditionne tout ce qui
suit...
;o)))

--
@+
;o)))








Avatar
laurent.daures
mes excuses,
j'avais oublié d'inscrire "convertir" dans la première macro.
Dans l'ordre, les macros s'exécutent ainsi,
d'abord enlever les caractères sépciaux chr(10)
puis convertir,
puis inverser les colonnes,
puis les nombres situés à droite de l'adresse.

'*******************
Sub Caractères_spéciaux()
For Each cell In Range("a1:a" & _
Range("a65536").End(xlUp).Row)
On Error Resume Next
' cell.Select
cell.Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
Next
CONVERTIR
inverser_colonnes
NOMBRES
End Sub
'*******************
Sub CONVERTIR()
'coller les adresses dans la colonne A
Columns(1).Select
'première macro
Selection.TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:úlse, Comma:=True, _
Space:úlse, Other:úlse, _
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
End Sub
'**************
Sub inverser_colonnes()
'deuxième macro
For Each cell In Range("a1:a" & Range _
("a65536").End(xlUp).Row)
If IsNumeric(cell) Then
cell.Offset(0, 1).Cut
cell.Insert Shift:=xlToRight
End If
Next
End Sub
'*******************
Sub NOMBRES()
'3e macro
For Each cell In Range("a1:a" & _
Range("a65536").End(xlUp).Row)
For i = 4 To 1 Step (-1)
If IsNumeric(Left(cell, i)) Then
cell.Offset(0, 1) = Left(cell, i)
cell.Value = Right(cell, Len(cell) - i)
End If
If IsNumeric(Right(cell, i)) Then
cell.Offset(0, 1) = Right(cell, i)
cell.Value = Left(cell, Len(cell) - i)
End If
Next
Next
End Sub
'*************
A plus

Amicalement
Siesting Hoax
Avatar
Modeste
Bonsour® laurent.daures avec ferveur ;o)))

dans l'esprit de ce qui a déja été proposé

deux petites siouxeries sous forme de fonction personnalisées :

Function chiffres(target)
chiffres = ""
For i = 1 To Len(target)
If InStr("0123456789-", Mid(target, i, 1)) > 0 Then
chiffres = chiffres & Mid(target, i, 1)
End If
Next
While Left(chiffres, 1) = "-"
chiffres = Mid(chiffres, 2, 9 ^ 9)
Wend
While Right(chiffres, 1) = "-"
chiffres = Left(chiffres, Len(chiffres) - 1)
Wend
End Function

Function lettres(target)
lettres = ""
target = Application.Substitute(target, Chr(10), Chr(32))
For i = 1 To Len(target)
If InStr(1, "abcdefghijklmnopqrstuvwxyzéèçêâô '-", Mid(target, i, 1), 1) > 0 Then
lettres = lettres & Mid(target, i, 1)
End If
Next
lettres = Application.Trim(lettres)
While Left(lettres, 1) = "-"
lettres = Mid(lettres, 2, 9 ^ 9)
Wend
While Right(lettres, 1) = "-"
lettres = Left(lettres, Len(lettres) - 1)
Wend
lettres = Application.Trim(lettres)
End Function

reste plus qu' a traiter manuellement les cas ZI CP BP Cedex Cidex ZAC ZUP etc...
:-(
exemple :
ZI la Renaissance 15 bis, rue du 11 novembre 1918 BP22 Cedex 18

Lettres : ZI la Renaissance bis rue du novembre BP Cedex
Chiffres : 151119182218

on se décarcasse ...
et pendant ce temps là le major Marmeduke est en vadrouille !!!
;o)))


--
--
@+
;o)))
Avatar
rthompson
Marmeduke ne se prélasse pas

Il vient de passer trois heures avec les responsable de cette @&# de base de
données

Et j'aime autant vous dire que mes paroles n'ont toutes été digne du Major

Mais ceci dis, gràce à vous, on avance bien
La nouvelle base sera "Verouillée" de toutes part et les fantaisies seront
impossible

Et les données commence tout doucement à ressembler à quelques chose

Merci à vous pour vos réactions et vos réponses

Je crois que pour l'addresse on touche au bout de ce qui est possible
automatiquement

Pour les Zoning je pense (et oui, cela m'arrive) avoir une idée

A première vue, la majorité de ces adresses commence par ZI ou Z.I.
Et contiennent une virgule après le nom du zoning et avant le nom de rue

Y aurait-il moyen de faire en sorte que

Si la cellule commence par "ZI" (ou autre chose)
de mettre tout ce qui avant la virgule dans une cellule
et tout ce qui suit la virgule dans la cellule suivante
Et de mettre la virgule ou le soleil ne brille pas

Mais quoi qu'il en soit un tout tout grand merci

Et à bientôt

Rex





"Modeste" a écrit dans le message de news:

Bonsour® laurent.daures avec ferveur ;o)))

dans l'esprit de ce qui a déja été proposé

deux petites siouxeries sous forme de fonction personnalisées :

Function chiffres(target)
chiffres = ""
For i = 1 To Len(target)
If InStr("0123456789-", Mid(target, i, 1)) > 0 Then
chiffres = chiffres & Mid(target, i, 1)
End If
Next
While Left(chiffres, 1) = "-"
chiffres = Mid(chiffres, 2, 9 ^ 9)
Wend
While Right(chiffres, 1) = "-"
chiffres = Left(chiffres, Len(chiffres) - 1)
Wend
End Function

Function lettres(target)
lettres = ""
target = Application.Substitute(target, Chr(10), Chr(32))
For i = 1 To Len(target)
If InStr(1, "abcdefghijklmnopqrstuvwxyzéèçêâô '-", Mid(target, i,
1), 1) > 0 Then
lettres = lettres & Mid(target, i, 1)
End If
Next
lettres = Application.Trim(lettres)
While Left(lettres, 1) = "-"
lettres = Mid(lettres, 2, 9 ^ 9)
Wend
While Right(lettres, 1) = "-"
lettres = Left(lettres, Len(lettres) - 1)
Wend
lettres = Application.Trim(lettres)
End Function

reste plus qu' a traiter manuellement les cas ZI CP BP Cedex Cidex ZAC ZUP
etc...
:-(
exemple :
ZI la Renaissance 15 bis, rue du 11 novembre 1918 BP22 Cedex 18

Lettres : ZI la Renaissance bis rue du novembre BP Cedex
Chiffres : 151119182218

on se décarcasse ...
et pendant ce temps là le major Marmeduke est en vadrouille !!!
;o)))


--
--
@+
;o)))
Avatar
rthompson
Bonjour

Et c'est pour cette fois
On te pardonne
Mais que cela ne se représente plus :-)))

Sinon le croquemitaine va venir te chercher

Et lui aura vite fait de te "convertir"

Un grand merci à toi aussi
On avance très bien dans ce fichier

J'en suis à la colonne 38 sur 52 et je crois que les dernières seront à mon
niveau

C'était surtout pour ces addresses que j'avais énormément de soucis

A très bientôt

Et encore merci

Rex




"laurent.daures" a écrit dans le message de news:
48887b2f$0$933$
mes excuses,
j'avais oublié d'inscrire "convertir" dans la première macro.
Dans l'ordre, les macros s'exécutent ainsi,
d'abord enlever les caractères sépciaux chr(10)
puis convertir,
puis inverser les colonnes,
puis les nombres situés à droite de l'adresse.

'*******************
Sub Caractères_spéciaux()
For Each cell In Range("a1:a" & _
Range("a65536").End(xlUp).Row)
On Error Resume Next
' cell.Select
cell.Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
Next
CONVERTIR
inverser_colonnes
NOMBRES
End Sub
'*******************
Sub CONVERTIR()
'coller les adresses dans la colonne A
Columns(1).Select
'première macro
Selection.TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:úlse, Comma:=True, _
Space:úlse, Other:úlse, _
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
End Sub
'**************
Sub inverser_colonnes()
'deuxième macro
For Each cell In Range("a1:a" & Range _
("a65536").End(xlUp).Row)
If IsNumeric(cell) Then
cell.Offset(0, 1).Cut
cell.Insert Shift:=xlToRight
End If
Next
End Sub
'*******************
Sub NOMBRES()
'3e macro
For Each cell In Range("a1:a" & _
Range("a65536").End(xlUp).Row)
For i = 4 To 1 Step (-1)
If IsNumeric(Left(cell, i)) Then
cell.Offset(0, 1) = Left(cell, i)
cell.Value = Right(cell, Len(cell) - i)
End If
If IsNumeric(Right(cell, i)) Then
cell.Offset(0, 1) = Right(cell, i)
cell.Value = Left(cell, Len(cell) - i)
End If
Next
Next
End Sub
'*************
A plus

Amicalement
Siesting Hoax



Avatar
laurent.daures
>on se décarcasse ...
et pendant ce temps là le major Marmeduke est en vadrouille !!!


Pas grave, vous n'avez qu'à faire la sieste pendant ce temps ;-)))

voici la dernière version,
j'ai l'impression que ça marche très bien, du moins avec les données du
fichier, s'il n'y a pas d'autres bricoles du genre ZAC ou ZUP;-))).
Un peu bourrin, mais efficace et adapté au fichier
'********************************
Sub Caractères_spéciaux()
Application.ScreenUpdating = False
For Each cell In Range("a3:a" & _
Range("a65536").End(xlUp).Row)
On Error Resume Next
cell.Offset(0, 1).Replace What:="," & caractère, Replacement:="" &
caractère, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
cell.Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
For Each caractère In Array("a", "b", "c", "d", "e", "f", "g", "h",
_
"i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", _
"u", "v", "w", "x", "y", "z")
cell.Replace What:=LCase(caractère) & "-",
Replacement:=LCase(caractère) _
& " ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse, _
SearchFormat:úlse, ReplaceFormat:úlse

cell.Replace What:="-" & caractère, Replacement:=" " & caractère, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse, _
SearchFormat:úlse, ReplaceFormat:úlse
Next
Next
CONVERTIR
inverser_colonnes
NOMBRES
BP
ZI
'2e passage pour les nombres restant
NOMBRES
End Sub
'************
Sub CONVERTIR()
'coller les adresses dans la colonne A
Columns(1).Select
'première macro
Selection.TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:úlse, Comma:=True, _
Space:úlse, Other:úlse, _
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
End Sub
'****************
Sub inverser_colonnes()
'deuxième macro
For Each cell In Range("a3:a" & Range _
("a65536").End(xlUp).Row)
If IsNumeric(cell) Then
cell.Offset(0, 1).Cut
cell.Insert Shift:=xlToRight
End If
Next
End Sub
'**************
Sub NOMBRES()
'3e macro
For Each cell In Range("a3:a" & _
Range("a65536").End(xlUp).Row)
For i = 6 To 1 Step (-1)
If IsNumeric(Left(cell, i)) Then
cell.Offset(0, 1) = Left(cell, i)
cell.Value = Right(cell, Len(cell) - i)
End If
If IsNumeric(Right(cell, i)) Then
cell.Offset(0, 1) = Right(cell, i)
cell.Value = Left(cell, Len(cell) - i)
End If
Next
Next
End Sub
'***********
Sub BP()
For Each nom In Array("BP", "CP")
For Each cell In Range("a3:a" & Range("a65536").End(xlUp).Row)
If Right(UCase(cell), 2) = UCase(nom) Then
cell.Offset(0, 2) = nom & " " & cell.Offset(0, 1)
cell.Value = Left(cell, (Len(cell) - 2))
cell.Offset(0, 1) = ""
End If
Next
Next
End Sub
'*************
Sub ZI()
On Error Resume Next
For Each cell In Range("a3:a" & Range("a65536").End(xlUp).Row)
If Left(UCase(cell), 2) = UCase("ZI") Then
For i = 1 To Len(cell)
Adr = Right(cell, Len(cell) - i)
If Left(Adr, 1) = "-" Then
Adr = Left(cell, i)
cell.Offset(0, 2) = Adr
cell.Value = Right(cell, Len(cell) - i - 2)
End If
Next
End If
cell.Offset(0, 1).Replace What:="," & caractère, Replacement:="" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
For i = 0 To 9
cell.Offset(0, 1).Replace What:=" " & caractère, Replacement:="" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
cell.Offset(0, 1).Replace What:="i " & caractère, Replacement:="i" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
cell.Offset(0, 1).Replace What:=" i" & caractère, Replacement:="i" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
Next
cell.Offset(0, 1) = cell.Offset(0, 1) * 1
Next
End Sub
'*************************

A plus
Amicalement
Siesting Hoax


"Modeste" a écrit dans le message de news:

Bonsour® laurent.daures avec ferveur ;o)))

dans l'esprit de ce qui a déja été proposé

deux petites siouxeries sous forme de fonction personnalisées :

Function chiffres(target)
chiffres = ""
For i = 1 To Len(target)
If InStr("0123456789-", Mid(target, i, 1)) > 0 Then
chiffres = chiffres & Mid(target, i, 1)
End If
Next
While Left(chiffres, 1) = "-"
chiffres = Mid(chiffres, 2, 9 ^ 9)
Wend
While Right(chiffres, 1) = "-"
chiffres = Left(chiffres, Len(chiffres) - 1)
Wend
End Function

Function lettres(target)
lettres = ""
target = Application.Substitute(target, Chr(10), Chr(32))
For i = 1 To Len(target)
If InStr(1, "abcdefghijklmnopqrstuvwxyzéèçêâô '-", Mid(target, i,
1), 1) > 0 Then
lettres = lettres & Mid(target, i, 1)
End If
Next
lettres = Application.Trim(lettres)
While Left(lettres, 1) = "-"
lettres = Mid(lettres, 2, 9 ^ 9)
Wend
While Right(lettres, 1) = "-"
lettres = Left(lettres, Len(lettres) - 1)
Wend
lettres = Application.Trim(lettres)
End Function

reste plus qu' a traiter manuellement les cas ZI CP BP Cedex Cidex ZAC ZUP
etc...
:-(
exemple :
ZI la Renaissance 15 bis, rue du 11 novembre 1918 BP22 Cedex 18

Lettres : ZI la Renaissance bis rue du novembre BP Cedex
Chiffres : 151119182218

on se décarcasse ...
et pendant ce temps là le major Marmeduke est en vadrouille !!!
;o)))


--
--
@+
;o)))
Avatar
rthompson
Bonjour

Et me voilà de retour

Tester et ça fonctionne impeccable

Il me donne des résultats identiques aux autres
Ce qui confirme que si tous les chemins mène à Rome
Il y en encore beaucoup plus qui mène à la solution

Il ne me reste plus qu'à résoudre mon problème de zoning


A bientôt et merci

Rex



"FFO" a écrit dans le message de news:

Salut à toi

Je te propose ce code
Le résultat dans les 2 colonnes adjacentes (B et C)

For Each c In Worksheets("Sheet1").Range("A3", "A" &
Range("A65535").End(xlUp).Row)
Caractères = " éèà,"
For i = 1 To Len(c)
A = UCase(Mid(c, i, 1))
If "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Like "*" & UCase(Mid(c, i, 1)) & "*" And
Mid(c, i, 1) <> "-" Then
Nom = Nom & Mid(c, i, 1)
Else
If Caractères Like "*" & Mid(c, i, 1) & "*" = False And Mid(c, i, 1) <>
"-"
Then
Chiffre = Chiffre & Mid(c, i, 1)
End If
End If
If Caractères Like "*" & Mid(c, i, 1) & "*" And Mid(c, i, 1) <> "," Then
Nom = Nom & Mid(c, i, 1)
End If
If "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Like "*" & UCase(Mid(c, i + 1, 1)) & "*"
And
Mid(c, i, 1) = "-" Then
Nom = Nom & Mid(c, i, 1)
Else
If Mid(c, i, 1) = "-" Then
Chiffre = Chiffre & Mid(c, i, 1)
End If
End If
Next
c.Offset(0, 1) = Nom
c.Offset(0, 2) = Chiffre
Nom = ""
Chiffre = ""
Next


Sur ce lien ton fichier avec la macro Traitement

http://www.cijoint.fr/cjlink.php?file=cj200807/cijk0u8uin.xls

Fais des essais et dis moi !!!


"rthompson" wrote:

Encore une fois

Il s'agit d'un "Cadeau" d'une personne ayant quitté la société

Dans Filemaker, il n'avait rien de spécifique pour les addresse et chacun
y
mettait ce qu'il voulait

Maintenant que je suis parvenu à les convaincre d'utilser Act (no pub
please)
et que nous mettons en place une structure et des formats spécifiques
cela devrait aller beaucoup mieux
En ce qui concerne les anciennes entrées, la réaction est simple

Oh, that's not a problem, just ask Rex to sort things out


Donc voilà l'apprenti dans la cadoue

Parce que je te signale, que cette colonne n'en est qu'une
J'en ai une "Floppée" d'autre à régler
Et j'avance pas mal

Mais ici, je coince totalement
Et je me vois mal en rectifier environ 10.000 à la main

A bientôt

Rex




"Modeste" a écrit dans le message de news:
%
Bonsour® Daniel.C avec ferveur ;o))) vous nous disiez :

> En suppposant que les nombres soient toujours en tête.
> En A1 : 100 aaa ZI www
> Pour extraire le nombre :
> =CNUM(GAUCHE(A1;TROUVE(" ";A1)-1))
> pour extraire la partie centrale :
> =STXT(A1;TROUVE(" ";A1)+1;TROUVE("ZI";A1)-TROUVE(" ";A1)-2)
> Pour extraire la chaîne se trouvant après ZI :
> =STXT(A1;TROUVE("ZI";A1)+3;9^9)

:-(
pas si simple que cela ...
selon l'exemple fourni par T.Rex !!!!

comment differencier /isoler :
ZI Rennes Sud-Est (ZI Rennes Sud-Est - 10 rue du Breil) (ZUP ZAC
etc...)
BP 93035 (Rue de la Halte BP 93035) ( Cedex Cidex etc...)
CP 7289 (Pont Bessières, 3 CP 7289)
ces 2 derniers incorporent de plus un saut de ligne

les adresses dont le numéro de voie est à la fin (Rue Despourrins, 6-8)
de
celles ou il est au début (99, rue de l'Abbé Groult)
les adresses ou il n'y a pas de séparateur commun (89 av. Charles de
Gaulle)
ou il n'y a pas de numero de voie (Mas de Grille)
ou les numéro de voie sont composites ( 17-21 , 22 ter)
les noms de voie numérique (rue du 11 novembre 1918)

une solution possible serait de faire un tri des toutes ces adresses
- les regrouper par type de libellé
- séparer dans des feuilles séparées chaque type pour y appliquer un
données
> convertir : adéquat
- un bonne petites dizaines de procs distinctes
- pas mal de manips à la main (inversions, remise en place de colonne)
- certainement pas mal de controle et correction aprés coup
- puis remettre tout en commun...
;o)))


:-(
mais je ne vois pas de procédure simple et universelle

Tu vois Rex, pour faire un parallele avec le suivi de commande (on avait
oublié le conditionnement ;o))).
Ici c'est la collectage correct des adresses qui conditionne tout ce qui
suit...
;o)))

--
@+
;o)))







Avatar
rthompson
Bonsoir


Celle-ci je regarderai demain
Maintenant je rentre me faire un petit souper

Bone Appetit
Bonne Soirée
Et Bonne Nuit

Rex



"laurent.daures" a écrit dans le message de news:
4888a93e$0$966$
>on se décarcasse ...
et pendant ce temps là le major Marmeduke est en vadrouille !!!


Pas grave, vous n'avez qu'à faire la sieste pendant ce temps ;-)))

voici la dernière version,
j'ai l'impression que ça marche très bien, du moins avec les données du
fichier, s'il n'y a pas d'autres bricoles du genre ZAC ou ZUP;-))).
Un peu bourrin, mais efficace et adapté au fichier
'********************************
Sub Caractères_spéciaux()
Application.ScreenUpdating = False
For Each cell In Range("a3:a" & _
Range("a65536").End(xlUp).Row)
On Error Resume Next
cell.Offset(0, 1).Replace What:="," & caractère, Replacement:="" &
caractère, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
cell.Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:úlse, SearchFormat:úlse, _
ReplaceFormat:úlse
For Each caractère In Array("a", "b", "c", "d", "e", "f", "g", "h",
_
"i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", _
"u", "v", "w", "x", "y", "z")
cell.Replace What:=LCase(caractère) & "-",
Replacement:=LCase(caractère) _
& " ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse, _
SearchFormat:úlse, ReplaceFormat:úlse

cell.Replace What:="-" & caractère, Replacement:=" " & caractère, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse, _
SearchFormat:úlse, ReplaceFormat:úlse
Next
Next
CONVERTIR
inverser_colonnes
NOMBRES
BP
ZI
'2e passage pour les nombres restant
NOMBRES
End Sub
'************
Sub CONVERTIR()
'coller les adresses dans la colonne A
Columns(1).Select
'première macro
Selection.TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:úlse, Comma:=True, _
Space:úlse, Other:úlse, _
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
End Sub
'****************
Sub inverser_colonnes()
'deuxième macro
For Each cell In Range("a3:a" & Range _
("a65536").End(xlUp).Row)
If IsNumeric(cell) Then
cell.Offset(0, 1).Cut
cell.Insert Shift:=xlToRight
End If
Next
End Sub
'**************
Sub NOMBRES()
'3e macro
For Each cell In Range("a3:a" & _
Range("a65536").End(xlUp).Row)
For i = 6 To 1 Step (-1)
If IsNumeric(Left(cell, i)) Then
cell.Offset(0, 1) = Left(cell, i)
cell.Value = Right(cell, Len(cell) - i)
End If
If IsNumeric(Right(cell, i)) Then
cell.Offset(0, 1) = Right(cell, i)
cell.Value = Left(cell, Len(cell) - i)
End If
Next
Next
End Sub
'***********
Sub BP()
For Each nom In Array("BP", "CP")
For Each cell In Range("a3:a" & Range("a65536").End(xlUp).Row)
If Right(UCase(cell), 2) = UCase(nom) Then
cell.Offset(0, 2) = nom & " " & cell.Offset(0, 1)
cell.Value = Left(cell, (Len(cell) - 2))
cell.Offset(0, 1) = ""
End If
Next
Next
End Sub
'*************
Sub ZI()
On Error Resume Next
For Each cell In Range("a3:a" & Range("a65536").End(xlUp).Row)
If Left(UCase(cell), 2) = UCase("ZI") Then
For i = 1 To Len(cell)
Adr = Right(cell, Len(cell) - i)
If Left(Adr, 1) = "-" Then
Adr = Left(cell, i)
cell.Offset(0, 2) = Adr
cell.Value = Right(cell, Len(cell) - i - 2)
End If
Next
End If
cell.Offset(0, 1).Replace What:="," & caractère, Replacement:="" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
For i = 0 To 9
cell.Offset(0, 1).Replace What:=" " & caractère, Replacement:="" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
cell.Offset(0, 1).Replace What:="i " & caractère, Replacement:="i" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
cell.Offset(0, 1).Replace What:=" i" & caractère, Replacement:="i" & _
caractère, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:úlse,
_
SearchFormat:úlse, ReplaceFormat:úlse
Next
cell.Offset(0, 1) = cell.Offset(0, 1) * 1
Next
End Sub
'*************************

A plus
Amicalement
Siesting Hoax


"Modeste" a écrit dans le message de news:

Bonsour® laurent.daures avec ferveur ;o)))

dans l'esprit de ce qui a déja été proposé

deux petites siouxeries sous forme de fonction personnalisées :

Function chiffres(target)
chiffres = ""
For i = 1 To Len(target)
If InStr("0123456789-", Mid(target, i, 1)) > 0 Then
chiffres = chiffres & Mid(target, i, 1)
End If
Next
While Left(chiffres, 1) = "-"
chiffres = Mid(chiffres, 2, 9 ^ 9)
Wend
While Right(chiffres, 1) = "-"
chiffres = Left(chiffres, Len(chiffres) - 1)
Wend
End Function

Function lettres(target)
lettres = ""
target = Application.Substitute(target, Chr(10), Chr(32))
For i = 1 To Len(target)
If InStr(1, "abcdefghijklmnopqrstuvwxyzéèçêâô '-", Mid(target, i,
1), 1) > 0 Then
lettres = lettres & Mid(target, i, 1)
End If
Next
lettres = Application.Trim(lettres)
While Left(lettres, 1) = "-"
lettres = Mid(lettres, 2, 9 ^ 9)
Wend
While Right(lettres, 1) = "-"
lettres = Left(lettres, Len(lettres) - 1)
Wend
lettres = Application.Trim(lettres)
End Function

reste plus qu' a traiter manuellement les cas ZI CP BP Cedex Cidex ZAC ZUP
etc...
:-(
exemple :
ZI la Renaissance 15 bis, rue du 11 novembre 1918 BP22 Cedex 18

Lettres : ZI la Renaissance bis rue du novembre BP Cedex
Chiffres : 151119182218

on se décarcasse ...
et pendant ce temps là le major Marmeduke est en vadrouille !!!
;o)))


--
--
@+
;o)))



Avatar
Modeste
Bonsour® rthompson avec ferveur ;o))) vous nous disiez :

Celle-ci je regarderai demain
Bone Appetit


;o))) histoire de ronger un Os
Bonne Soirée
Et Bonne Nuit



pour dormir l'esprit tranquille
voilà mon dernier jus :
http://cjoint.com/?hyx57VtG81

:-(
reste encore un petit ennui avec :
Pont Bessières, 3
CP 7289
qui donne :
Pont Bessières CP 37289


--
@+
;o)))
1 2 3