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
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
... 150 lignes...
"Tatanka"
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
---------------------------------------------------------------
Merci
Serge
"MichD"
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"
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 :
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"
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
---------------------------------------------------------------
au no. 43 ligne 44
rue = R4eAvenue
c'est correct ?
isabelle
Le 2013-08-21 12:06, Tatanka a écrit :
La chaleur, sans doute !
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+
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"