Extraire des données

Le
Tatanka
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Tatanka
Le #25606032
Pas encore tout à fait réveillé!
... 150 lignes...


"Tatanka"
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


MichD
Le #25606092
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
---------------------------------------------------------------
Tatanka
Le #25606192
Un maudit beau départ!
Merci

Serge

"MichD"
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
---------------------------------------------------------------

Tatanka
Le #25606212
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"
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
---------------------------------------------------------------

isabelle
Le #25606242
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


Tatanka
Le #25606362
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"
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


MichD
Le #25606352
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
---------------------------------------------------------------
isabelle
Le #25606372
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"
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








Tatanka
Le #25606422
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+
Tatanka
Le #25616912
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"
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
---------------------------------------------------------------

Publicité
Poster une réponse
Anonyme