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 ;-((((((
héhé, avec mes macros, on a bien le 3 lol ! Faut dire que les adresses, ça me connait ;-))) bon, je vais au boulot, bonne journée Amicalement Siesting Hoax
"Modeste" a écrit dans le message de news: %23Pcb% 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)))
héhé,
avec mes macros, on a bien le 3 lol !
Faut dire que les adresses, ça me connait ;-)))
bon, je vais au boulot, bonne journée
Amicalement
Siesting Hoax
"Modeste" <nomail@nomail.net> a écrit dans le message de news:
%23Pcb%23qd7IHA.4652@TK2MSFTNGP05.phx.gbl...
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
héhé, avec mes macros, on a bien le 3 lol ! Faut dire que les adresses, ça me connait ;-))) bon, je vais au boulot, bonne journée Amicalement Siesting Hoax
"Modeste" a écrit dans le message de news: %23Pcb% 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)))
rthompson
Bonjour
ET MERCI
C'est un peu lent, mais cela fonctionne
A ton avis, si je le lance sur la base totale (10.000 lignes) va-t-il aller jusqu'au bout? Ou va-t-il se planter?
Il vaudrait peut-être mieux travailler par petit bout (500 ou 1.000 ligne) et recomposer après non?
Autre chose, que je ne comprends pas
Si je lance tes macros, soit directement de VBA ou de la flèche Macro cela tourne jusqu'au bout
Par contre j'ai créé un bouton avec ce code ci-dessous Et il plante sur le bout Convertir Tout le bloc est en jaune à partir de sélection
C'est pas grâve, parce que c'est un truc que j'utiliserai une fois Mais j'aime savoir ce que je fais de mal
Un grand merci à toi pour le boulot et la patience
Rex
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Private Sub CommandButton1_Click() Caractères_spéciaux CONVERTIR inverser_colonnes NOMBRES BP ZI NOMBRES End Sub xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
"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)))
Bonjour
ET MERCI
C'est un peu lent, mais cela fonctionne
A ton avis, si je le lance sur la base totale (10.000 lignes) va-t-il aller
jusqu'au bout?
Ou va-t-il se planter?
Il vaudrait peut-être mieux travailler par petit bout (500 ou 1.000 ligne)
et recomposer après non?
Autre chose, que je ne comprends pas
Si je lance tes macros, soit directement de VBA ou de la flèche Macro cela
tourne jusqu'au bout
Par contre j'ai créé un bouton avec ce code ci-dessous
Et il plante sur le bout Convertir
Tout le bloc est en jaune à partir de sélection
C'est pas grâve, parce que c'est un truc que j'utiliserai une fois
Mais j'aime savoir ce que je fais de mal
Un grand merci à toi pour le boulot et la patience
Rex
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Private Sub CommandButton1_Click()
Caractères_spéciaux
CONVERTIR
inverser_colonnes
NOMBRES
BP
ZI
NOMBRES
End Sub
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
"laurent.daures" <laurent.daures@orange.fr> a écrit dans le message de news:
4888a93e$0$966$ba4acef3@news.orange.fr...
>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" <nomail@nomail.net> a écrit dans le message de news:
e1FtLpZ7IHA.1196@TK2MSFTNGP05.phx.gbl...
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)))
A ton avis, si je le lance sur la base totale (10.000 lignes) va-t-il aller jusqu'au bout? Ou va-t-il se planter?
Il vaudrait peut-être mieux travailler par petit bout (500 ou 1.000 ligne) et recomposer après non?
Autre chose, que je ne comprends pas
Si je lance tes macros, soit directement de VBA ou de la flèche Macro cela tourne jusqu'au bout
Par contre j'ai créé un bouton avec ce code ci-dessous Et il plante sur le bout Convertir Tout le bloc est en jaune à partir de sélection
C'est pas grâve, parce que c'est un truc que j'utiliserai une fois Mais j'aime savoir ce que je fais de mal
Un grand merci à toi pour le boulot et la patience
Rex
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Private Sub CommandButton1_Click() Caractères_spéciaux CONVERTIR inverser_colonnes NOMBRES BP ZI NOMBRES End Sub xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
"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)))
rthompson
Bonjour Modeste
Ben tu vois, maintenant je suis comme Angélique Je suis confronté au problème du choix!! (Ici, tu peux creuser tes connaissances cinéphile pour trouver l'origine de ce dialogue)
La macro de Laurent est impeccable, mais lente On voit très bien qu'il est un "spécialiste" des addresses
A mon avis il collectionne les "Bonnes Adresses" pour son plaisir personnel ;-)))
Par contre ton idée de fonction est nettement plus flexible
Il me suffit de coller dans la colonne A de ton fichier un paquet d'addresses et de récupérer l'info par groupe et coller/spécial
Et en plus j'ai appris quelque chose ce qui n'est pas négligeable
Je ne sais pas encore celle que j'utiliserai J'ai encore quelques colonnes à régler et ce week-end sera le grrand transfer
Un tout grand merci à vous deux
Et ne vous en faites pas, j'ai pas fini de vous vous "embêter" avec mes requêtes
Rex
"Modeste" a écrit dans le message de news: %23Pcb% 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)))
Bonjour Modeste
Ben tu vois, maintenant je suis comme Angélique
Je suis confronté au problème du choix!!
(Ici, tu peux creuser tes connaissances cinéphile pour trouver l'origine de
ce dialogue)
La macro de Laurent est impeccable, mais lente
On voit très bien qu'il est un "spécialiste" des addresses
A mon avis il collectionne les "Bonnes Adresses" pour son plaisir personnel
;-)))
Par contre ton idée de fonction est nettement plus flexible
Il me suffit de coller dans la colonne A de ton fichier un paquet
d'addresses
et de récupérer l'info par groupe
et coller/spécial
Et en plus j'ai appris quelque chose ce qui n'est pas négligeable
Je ne sais pas encore celle que j'utiliserai
J'ai encore quelques colonnes à régler et ce week-end sera le grrand
transfer
Un tout grand merci à vous deux
Et ne vous en faites pas, j'ai pas fini de vous vous "embêter" avec mes
requêtes
Rex
"Modeste" <nomail@nomail.net> a écrit dans le message de news:
%23Pcb%23qd7IHA.4652@TK2MSFTNGP05.phx.gbl...
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
Ben tu vois, maintenant je suis comme Angélique Je suis confronté au problème du choix!! (Ici, tu peux creuser tes connaissances cinéphile pour trouver l'origine de ce dialogue)
La macro de Laurent est impeccable, mais lente On voit très bien qu'il est un "spécialiste" des addresses
A mon avis il collectionne les "Bonnes Adresses" pour son plaisir personnel ;-)))
Par contre ton idée de fonction est nettement plus flexible
Il me suffit de coller dans la colonne A de ton fichier un paquet d'addresses et de récupérer l'info par groupe et coller/spécial
Et en plus j'ai appris quelque chose ce qui n'est pas négligeable
Je ne sais pas encore celle que j'utiliserai J'ai encore quelques colonnes à régler et ce week-end sera le grrand transfer
Un tout grand merci à vous deux
Et ne vous en faites pas, j'ai pas fini de vous vous "embêter" avec mes requêtes
Rex
"Modeste" a écrit dans le message de news: %23Pcb% 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)))
rthompson
Bonjour Comme je viens de le dire à Modeste A mon avis tu collectionne les "Bonnes Addresses"
Faudra que te coince un jour pour que tu les partages
Nous aussi, on a droit aux plaisirs ;-)))))
Une fois de plus merci et à la prochaine
Rex
"laurent.daures" a écrit dans le message de news: 488953f8$0$956$
héhé, avec mes macros, on a bien le 3 lol ! Faut dire que les adresses, ça me connait ;-))) bon, je vais au boulot, bonne journée Amicalement Siesting Hoax
"Modeste" a écrit dans le message de news: %23Pcb% 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)))
Bonjour
Comme je viens de le dire à Modeste
A mon avis tu collectionne les "Bonnes Addresses"
Faudra que te coince un jour pour que tu les partages
Nous aussi, on a droit aux plaisirs ;-)))))
Une fois de plus merci et à la prochaine
Rex
"laurent.daures" <laurent.daures@orange.fr> a écrit dans le message de news:
488953f8$0$956$ba4acef3@news.orange.fr...
héhé,
avec mes macros, on a bien le 3 lol !
Faut dire que les adresses, ça me connait ;-)))
bon, je vais au boulot, bonne journée
Amicalement
Siesting Hoax
"Modeste" <nomail@nomail.net> a écrit dans le message de news:
%23Pcb%23qd7IHA.4652@TK2MSFTNGP05.phx.gbl...
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
Bonjour Comme je viens de le dire à Modeste A mon avis tu collectionne les "Bonnes Addresses"
Faudra que te coince un jour pour que tu les partages
Nous aussi, on a droit aux plaisirs ;-)))))
Une fois de plus merci et à la prochaine
Rex
"laurent.daures" a écrit dans le message de news: 488953f8$0$956$
héhé, avec mes macros, on a bien le 3 lol ! Faut dire que les adresses, ça me connait ;-))) bon, je vais au boulot, bonne journée Amicalement Siesting Hoax
"Modeste" a écrit dans le message de news: %23Pcb% 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