Disséquer une adresse
Bonjour à tous !
Je vous explique mon soucis.
J'ai un grande table avec plein d'adresse du type Adresse + BP + Code postal + Ville
Je souhaite mettre chacun de ces éléments dans des colonnes séparées.
Pour ce faire j'ai réalisé une macro cependant une ligne de la Macro ne fonctionne pas et je ne comprends absolument pas pourquoi :
Voici la macro :
Sub DissequerAdresse()
Dim SourceColonne As Integer, AdresseColonne As Integer, BPColonne As Integer
Dim CodePostalColonne As Integer, VilleColonne As Integer
Dim DebutLigne As Integer
Dim i As Long, e As Integer, a As Long, Txt As String
SourceColonne = 13 ' Colonne Source
AdresseColonne = 19 ' Colonne Adresse
BPColonne = 20 ' Colonne Boite postale
CodePostalColonne = 21 ' Colonne Code Postal
VilleColonne = 22 'Colonne Ville
DebutLigne = 4 'Première ligne "utile" de la feuille
With Sheets("Contacts")
For i = DebutLigne To Range("A65536").End(xlUp).Row
Txt = .Cells(i, SourceColonne)
For e = 4 To Len(Txt) 'de 4 à l'ensemble des caractères de la case
a = (Len(Txt) - e) ' On va aller à reculons ici car les premiers 5 chiffres en partant de la fin correspondent au CP
If IsNumeric(Mid(Txt, a, 5)) Or IsNumeric(Mid(Txt, a, 4)) Then ' Si on a 4 ou 5 chiffres consécutifs on entre dans la boucle
If IsEmpty(Cells(i, CodePostalColonne)) Then 'Si la case de la colonne code postale est vierge alors on peut dors et déja dire que :
.Cells(i, AdresseColonne) = Left(Txt, a - 1) 'Ce qui est à gauche est l'adresse (malheureusement ici elle comportera le BP aussi)
.Cells(i, VilleColonne) = Mid(Txt, a + 5) ' A droite ce sera La ville
.Cells(i, CodePostalColonne) = Mid(Txt, a, 5) ' Le code postal
Else
If IsNumeric(Mid(Txt, a, 5)) Then
Cells(i, BPColonne) = Mid(Txt, a, 5) 'si 5 chiffres et que la case de Code postal est non nulle alors on aura le BP
Else
Cells(i, BPColonne) = Mid(Txt, a, 4) 'Si 4 chiffres que la case de Code postal est non nulle alors on aura aussi le BP
End If
End If
End If
Next e
Exit For
Next i
End With
End SubLa ligne surlignée ne fonctionne pas or elle donne bien un booléen et devrais fonctionner .
Avez vous une quelconque idée de ce qui peut bien se passer ? J'ai pensé à des soucis de Null, au fait que ma variable Txt soit Null mais ce n'est pas ca car la ligne de départ est bien du texte.
Bref... Je comprends pas
Bonjour
Ton fichier serait plus pratique pour t'aider à trouver une solution
Quand tu as ton erreur (laquelle ?) vérifies la valeur de a
il vaut peut-être 0
car a = Len(Txt) - e mais e en fin de boucle For e = 4 To Len(Txt) vaut Len(Txt) ---> a = (Len(Txt) - Len(Txt)) = 0
Bonjour,
Une proposition (mais en l'absence de fichier joint je n'ai pas traité le cas des BP
Sub DissequerAdresse()
Dim SourceColonne As Integer, AdresseColonne As Integer, BPColonne As Integer
Dim CodePostalColonne As Integer, VilleColonne As Integer
Dim DebutLigne As Integer
Dim i%, ii%, k&, s$
SourceColonne = 13 ' Colonne Source
AdresseColonne = 19 ' Colonne Adresse
BPColonne = 20 ' Colonne Boite postale
CodePostalColonne = 21 ' Colonne Code Postal
VilleColonne = 22 'Colonne Ville
DebutLigne = 4 'Première ligne "utile" de la feuille
With Sheets("Contacts")
For k = DebutLigne To Range("A65536").End(xlUp).Row
s = .Cells(k, SourceColonne)
ii = Len(s) - 4
For i = ii To 1 Step -1
If Asc(Mid(s, i)) > 47 And Asc(Mid(s, i)) < 58 Then
.Cells(k, 22) = Trim(Mid(s, i + 1))
.Cells(k, 21).NumberFormat = "00000"
.Cells(k, 21) = Format(Trim(Mid(s, i - 5, 6)), "00000")
.Cells(k, 19) = Left(s, i - 5)
Exit For
End If
Next
'On peut traiter ici le cas des BP
'en examinant le contenu de .Cells(k, 19)
Next
End With
End SubA+