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

4 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
laurent.daures
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)))
Avatar
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)))



Avatar
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)))
Avatar
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)))



1 2 3