Extraire des données

Pas encore tout à fait réveillé!
... 150 lignes...


"Tatanka" <ramanujan@videotron.ca> a écrit dans le message de news: kv2af5$8pb$1@speranza.aioe.org...

Bonjour,
Voici la première ligne de ce que je veux extraire pour les cent lignes de la colonne C.
J'ai bien peur que ce soit mission impossible mais connaissant les sorciers d'Excel que
vous êtes, je vous soumets quand même mon problème!
http://cjoint.com/?0Hvn50Ait6y

J'espère que tout le monde se porte bien et si un miracle survient,
je vous en serai éternellement reconnaissant.

Serge, le Survenant

Bonjour,

Ceci devrait faire le gros du travail.

Quelques erreurs sont générées comme dans le cas
de la ligne 3 où tu as une virgule après Gisèle
2 Bégin, Gisèle, 490 4e Avenue 2 G1J 2Z9 1926-11-22 6 1194
Les autres lignes n'en ont pas...

C'est vrai aussi pour les noms comme Dagenais, Jean Philippe
Le prénom Jean Philippe a un espace et il est composé de 2 noms
au lieu d'un seul.

Pour tenir compte de tous les cas d'exception possible, cela prendrait
une procédure beaucoup plus élaborée!!!


'-----------------------------------------
Sub test()
Dim Rg As Range, C As Range, T As Variant
Dim X As Variant, Début As String, Fin As String

Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil2
Set Rg = .Range("C3:C150")
End With

For Each C In Rg
X = Split(C.Value, ",")
Début = X(0)
Fin = X(1)
C.Offset(, 1) = Split(Début, " ")(0)
C.Offset(, 2) = Split(Début, " ")(1)
T = Split(Trim(Fin), " ")
C.Offset(, 2) = T(0) & " " & C.Offset(, 2)
C.Offset(, 3) = T(1)
C.Offset(, 4) = T(2) & " " & T(3)
C.Offset(, 5) = T(4)
C.Offset(, 6) = T(5) & " " & T(6)
Next
Application.ScreenUpdating = True
Application.EnableEvents = False

End Sub
'-----------------------------------------

MichD
---------------------------------------------------------------

Un maudit beau départ!
Merci

Serge

"MichD" <michdenis@hotmail.com> a écrit dans le message de news: kv2dv5$iik$1@speranza.aioe.org...

Bonjour,

Ceci devrait faire le gros du travail.

Quelques erreurs sont générées comme dans le cas
de la ligne 3 où tu as une virgule après Gisèle
2 Bégin, Gisèle, 490 4e Avenue 2 G1J 2Z9 1926-11-22 6 1194
Les autres lignes n'en ont pas...

C'est vrai aussi pour les noms comme Dagenais, Jean Philippe
Le prénom Jean Philippe a un espace et il est composé de 2 noms
au lieu d'un seul.

Pour tenir compte de tous les cas d'exception possible, cela prendrait
une procédure beaucoup plus élaborée!!!


'-----------------------------------------
Sub test()
Dim Rg As Range, C As Range, T As Variant
Dim X As Variant, Début As String, Fin As String

Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil2
Set Rg = .Range("C3:C150")
End With

For Each C In Rg
X = Split(C.Value, ",")
Début = X(0)
Fin = X(1)
C.Offset(, 1) = Split(Début, " ")(0)
C.Offset(, 2) = Split(Début, " ")(1)
T = Split(Trim(Fin), " ")
C.Offset(, 2) = T(0) & " " & C.Offset(, 2)
C.Offset(, 3) = T(1)
C.Offset(, 4) = T(2) & " " & T(3)
C.Offset(, 5) = T(4)
C.Offset(, 6) = T(5) & " " & T(6)
Next
Application.ScreenUpdating = True
Application.EnableEvents = False

End Sub
'-----------------------------------------

MichD
---------------------------------------------------------------

J'y suis presque! Une seule anomalie.
J'ai enlevé les virgules et j'utilise cette macro:

Sub test2()
Dim Rg As Range, C As Range, T As Variant
Dim X As Variant, Début As String, Fin As String
Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil2
Set Rg = .Range("C2:C151")
End With
For Each C In Rg
T = Split(C.Value)
C.Offset(, 1) = T(0)
If IsNumeric(T(3)) Then
C.Offset(, 2) = T(1) & " " & T(2)
C.Offset(, 3) = T(3)
C.Offset(, 4) = T(4) & " " & T(5)
C.Offset(, 5) = T(6)
C.Offset(, 6) = T(7) & " " & T(8)
End If
If IsNumeric(T(4)) Then
C.Offset(, 2) = T(1) & " " & T(2) & " " & T(3)
C.Offset(, 3) = T(4)
C.Offset(, 4) = T(5) & " " & T(6)
C.Offset(, 5) = T(7)
C.Offset(, 6) = T(8) & " " & T(9)
End If
Next C
Application.ScreenUpdating = True
Application.EnableEvents = False
End Sub














"MichD" <michdenis@hotmail.com> a écrit dans le message de news: kv2dv5$iik$1@speranza.aioe.org...

Bonjour,

Ceci devrait faire le gros du travail.

Quelques erreurs sont générées comme dans le cas
de la ligne 3 où tu as une virgule après Gisèle
2 Bégin, Gisèle, 490 4e Avenue 2 G1J 2Z9 1926-11-22 6 1194
Les autres lignes n'en ont pas...

C'est vrai aussi pour les noms comme Dagenais, Jean Philippe
Le prénom Jean Philippe a un espace et il est composé de 2 noms
au lieu d'un seul.

Pour tenir compte de tous les cas d'exception possible, cela prendrait
une procédure beaucoup plus élaborée!!!


'-----------------------------------------
Sub test()
Dim Rg As Range, C As Range, T As Variant
Dim X As Variant, Début As String, Fin As String

Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil2
Set Rg = .Range("C3:C150")
End With

For Each C In Rg
X = Split(C.Value, ",")
Début = X(0)
Fin = X(1)
C.Offset(, 1) = Split(Début, " ")(0)
C.Offset(, 2) = Split(Début, " ")(1)
T = Split(Trim(Fin), " ")
C.Offset(, 2) = T(0) & " " & C.Offset(, 2)
C.Offset(, 3) = T(1)
C.Offset(, 4) = T(2) & " " & T(3)
C.Offset(, 5) = T(4)
C.Offset(, 6) = T(5) & " " & T(6)
Next
Application.ScreenUpdating = True
Application.EnableEvents = False

End Sub
'-----------------------------------------

MichD
---------------------------------------------------------------

salut Serge,

un début de piste,

lLast = Cells(Cells.Rows.Count, 3).End(xlUp).Row

For i = 2 To lLast

sCP = Mid(Right(Cells(i, 3), 25), 1, 7)
chaine = Mid(Cells(i, 3), 1, Len(Cells(i, 3)) - 26)
e = Application.Search(" ", chaine)
sNo = Left(chaine, e)

For y = e + 1 To Len(chaine)
dAddress = y
If IsNumeric(Mid(chaine, y, 1)) Then
sNom = Mid(chaine, e, y - e - 1)
Exit For
End If
Next

sAddress = Mid(chaine, dAddress, Len(chaine) - (Len(sNo) + Len(sNom)))
aAddress = Split(sAddress, " ")
sCivique = aAddress(0)

For y = 1 To UBound(aAddress) - 1
sRue = sRue & aAddress(y)
Next

sAppart = aAddress(UBound(aAddress))

Cells(i, 4) = sNo
Cells(i, 5) = sNom
Cells(i, 6) = sCivique
Cells(i, 7) = sRue
Cells(i, 8) = sAppart
Cells(i, 9) = sCPNext
sRue = ""
Next

isabelle

Le 2013-08-21 08:09, Tatanka a écrit :

Bonjour,
Voici la première ligne de ce que je veux extraire pour les cent lignes de la colonne C.
J'ai bien peur que ce soit mission impossible mais connaissant les sorciers d'Excel que
vous êtes, je vous soumets quand même mon problème!
http://cjoint.com/?0Hvn50Ait6y

J'espère que tout le monde se porte bien et si un miracle survient,
je vous en serai éternellement reconnaissant.

Serge, le Survenant

Un beau Bonjour Isabelle,

Ah ben! lâ, je suis estomaqué. Aucune anomalie.
J'ai une quarantaine de listes contenant de 50 à 500 lignes.
J'ai appelé ta macro Isabelle. Je l'ai testée sur deux listes et
aucune erreur. Ne me reste plus qu'à comprendre ce petit miracle!
J'ai au moins compris qu'il fallait remplacer Cells(i, 9) = sCPNext
par Cells(i, 9) = sCP. -:)

Bonne journée!
Serge

"isabelle" <i@v.org> a écrit dans le message de news: kv2lf8$809$1@speranza.aioe.org...

salut Serge,

un début de piste,

lLast = Cells(Cells.Rows.Count, 3).End(xlUp).Row

For i = 2 To lLast

sCP = Mid(Right(Cells(i, 3), 25), 1, 7)
chaine = Mid(Cells(i, 3), 1, Len(Cells(i, 3)) - 26)
e = Application.Search(" ", chaine)
sNo = Left(chaine, e)

For y = e + 1 To Len(chaine)
dAddress = y
If IsNumeric(Mid(chaine, y, 1)) Then
sNom = Mid(chaine, e, y - e - 1)
Exit For
End If
Next

sAddress = Mid(chaine, dAddress, Len(chaine) - (Len(sNo) + Len(sNom)))
aAddress = Split(sAddress, " ")
sCivique = aAddress(0)

For y = 1 To UBound(aAddress) - 1
sRue = sRue & aAddress(y)
Next

sAppart = aAddress(UBound(aAddress))

Cells(i, 4) = sNo
Cells(i, 5) = sNom
Cells(i, 6) = sCivique
Cells(i, 7) = sRue
Cells(i, 8) = sAppart
Cells(i, 9) = sCPNext
sRue = ""
Next

isabelle

Le 2013-08-21 08:09, Tatanka a écrit :

Bonjour,
Voici la première ligne de ce que je veux extraire pour les cent lignes de la colonne C.
J'ai bien peur que ce soit mission impossible mais connaissant les sorciers d'Excel que
vous êtes, je vous soumets quand même mon problème!
http://cjoint.com/?0Hvn50Ait6y

J'espère que tout le monde se porte bien et si un miracle survient,
je vous en serai éternellement reconnaissant.

Serge, le Survenant

Cette procédure ne génère qu'une erreur où il y a un
caractère inutile qui a été inséré pour cet item :
43 Gagné, Yves 570 R 4e Avenue 0 G1J 3A2 1965-12-08 6 1194

Le caractère "R" après 570


'-----------------------------------------
Sub test()
Dim Rg As Range, C As Range, T As Variant
Dim A As Variant, B As Long, Texte As String
Dim X As Variant, Début As String, Fin As String
Dim K As Variant

Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil2
Set Rg = .Range("C2:C151")
End With

For Each C In Rg
p = p + 1

X = Split(C.Value, " ")
C.Offset(, 1) = X(0)
Début = Replace(C.Value, X(0) & " ", "")
For B = Len(X(0)) + 2 To Len(C.Value)
If IsNumeric(Mid(C, B, 1)) Then
A = Mid(C, B, 1)
Exit For
End If
Next
Texte = Trim(Mid(C.Value, Len(X(0)) + 2, B - (Len(X(0)) + 2)))
K = Split(Texte, ",")
C.Offset(, 2) = K(1) & " " & K(0)
Texte = Right(C.Value, Len(C.Value) - (Len(X(0)) + Len(Texte) + 2))
K = Split(Texte, " ")
C.Offset(, 3) = K(0)
C.Offset(, 4) = K(1) & " " & K(2)
C.Offset(, 5) = K(3)
C.Offset(, 6) = K(4) & K(5)
A = ""
Texte = ""
Next
Application.ScreenUpdating = True
Application.EnableEvents = False

End Sub
'-----------------------------------------

MichD
---------------------------------------------------------------

exact, surement un ctrl c mal placer,

au no. 43 ligne 44
rue = R4eAvenue
c'est correct ?

isabelle

Le 2013-08-21 12:06, Tatanka a écrit :

Un beau Bonjour Isabelle,

Ah ben! lâ, je suis estomaqué. Aucune anomalie.
J'ai une quarantaine de listes contenant de 50 à 500 lignes.
J'ai appelé ta macro Isabelle. Je l'ai testée sur deux listes et
aucune erreur. Ne me reste plus qu'à comprendre ce petit miracle!
J'ai au moins compris qu'il fallait remplacer Cells(i, 9) = sCPNext
par Cells(i, 9) = sCP. -:)

Bonne journée!
Serge

"isabelle" <i@v.org> a écrit dans le message de news: kv2lf8$809$1@speranza.aioe.org...

salut Serge,

un début de piste,

lLast = Cells(Cells.Rows.Count, 3).End(xlUp).Row

For i = 2 To lLast

sCP = Mid(Right(Cells(i, 3), 25), 1, 7)
chaine = Mid(Cells(i, 3), 1, Len(Cells(i, 3)) - 26)
e = Application.Search(" ", chaine)
sNo = Left(chaine, e)

For y = e + 1 To Len(chaine)
dAddress = y
If IsNumeric(Mid(chaine, y, 1)) Then
sNom = Mid(chaine, e, y - e - 1)
Exit For
End If
Next

sAddress = Mid(chaine, dAddress, Len(chaine) - (Len(sNo) + Len(sNom)))
aAddress = Split(sAddress, " ")
sCivique = aAddress(0)

For y = 1 To UBound(aAddress) - 1
sRue = sRue & aAddress(y)
Next

sAppart = aAddress(UBound(aAddress))

Cells(i, 4) = sNo
Cells(i, 5) = sNom
Cells(i, 6) = sCivique
Cells(i, 7) = sRue
Cells(i, 8) = sAppart
Cells(i, 9) = sCPNext
sRue = ""
Next

isabelle

Le 2013-08-21 08:09, Tatanka a écrit :

Bonjour,
Voici la première ligne de ce que je veux extraire pour les cent lignes de la colonne C.
J'ai bien peur que ce soit mission impossible mais connaissant les sorciers d'Excel que
vous êtes, je vous soumets quand même mon problème!
http://cjoint.com/?0Hvn50Ait6y

J'espère que tout le monde se porte bien et si un miracle survient,
je vous en serai éternellement reconnaissant.

Serge, le Survenant

exact, surement un ctrl c mal placer

La chaleur, sans doute !

au no. 43 ligne 44
rue = R4eAvenue
c'est correct ?

Moi ça ne me dérange pas du tout. Les maniaques voudraient
peut-être 570R 4eAvenue
M'en fous et je te remetcie à nouveau.

A+

Salut MichD et Isabelle,

Vos macros sont superbes mais ne fonctionnent pas correctement
pour toutes les listes que je leur donne à traiter.
Faut dire que mes données brutes sont un peu BIZZ !
En espérant que les nouvelles listes que je recevrai seront
un peu mieux organisées.
Encore merci. Vous êtes forts grave!

Serge


"MichD" <michdenis@hotmail.com> a écrit dans le message de news: kv2or4$hrs$1@speranza.aioe.org...

Cette procédure ne génère qu'une erreur où il y a un
caractère inutile qui a été inséré pour cet item :
43 Gagné, Yves 570 R 4e Avenue 0 G1J 3A2 1965-12-08 6 1194

Le caractère "R" après 570


'-----------------------------------------
Sub test()
Dim Rg As Range, C As Range, T As Variant
Dim A As Variant, B As Long, Texte As String
Dim X As Variant, Début As String, Fin As String
Dim K As Variant

Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil2
Set Rg = .Range("C2:C151")
End With

For Each C In Rg
p = p + 1

X = Split(C.Value, " ")
C.Offset(, 1) = X(0)
Début = Replace(C.Value, X(0) & " ", "")
For B = Len(X(0)) + 2 To Len(C.Value)
If IsNumeric(Mid(C, B, 1)) Then
A = Mid(C, B, 1)
Exit For
End If
Next
Texte = Trim(Mid(C.Value, Len(X(0)) + 2, B - (Len(X(0)) + 2)))
K = Split(Texte, ",")
C.Offset(, 2) = K(1) & " " & K(0)
Texte = Right(C.Value, Len(C.Value) - (Len(X(0)) + Len(Texte) + 2))
K = Split(Texte, " ")
C.Offset(, 3) = K(0)
C.Offset(, 4) = K(1) & " " & K(2)
C.Offset(, 5) = K(3)
C.Offset(, 6) = K(4) & K(5)
A = ""
Texte = ""
Next
Application.ScreenUpdating = True
Application.EnableEvents = False

End Sub
'-----------------------------------------

MichD
---------------------------------------------------------------