Séparer code postal / Ville en Macro

Terek

XLDnaute Nouveau
Bonjour,
Voila donc j'ai un gros fichier Excel ou mes codes postaux et villes sont dans la même cellule. Je voudrai a l'aide d'une maccro les séparer mais je ne connais pas la formule pour ca. Voila mon code actuel il ne me reste qu'a remplir les gros commentaires avec les fonction necéssaires

Code:
Sub separer_code_ville()
    
    Dim I As Long
    Dim Plage As Range

    Set Plage = Range("F2:F" & Range("F2").End(xlDown).Row)
    For I = Plage.End(xlDown).Row To 2 Step -1
        Cells(I, 5).Value = Cells(I, 6).Value '(LES 5 PREMIER CARACTèRES)
        Cells(I, 6).Value = 'SUPRIMER LES 5 PREMIER CARACTERES
    Next
    
End Sub

Merci beaucoup pour vos réponses a venir.
A bientot.
 

jigagneur

XLDnaute Nouveau
Re : Séparer code postal / Ville en Macro

bonjour,

peut être un début de solution

Cells(I, 5)= mid(Cells(I, 6),1,5) "le code est en position 1 et fait 5 caractères
nomville=mid(cells(I,5),7,10) "je suppose qu'il y a un espace entre le code et la ville et je cantonne à 10 caractères le nom de la ville
Cells(I, 6)= nomville
 

Terek

XLDnaute Nouveau
Re : Séparer code postal / Ville en Macro

Merci beaucoup ca fonctionne très bien. Mon code final :).

Code:
Sub separer_code_ville()
    
    Dim I As Long
    Dim Plage As Range
    Dim nomville As String
       
    Set Plage = Range("A2:A" & Range("A2").End(xlDown).Row)
    For I = Plage.End(xlDown).Row To 2 Step -1
        Cells(I, 5) = Mid(Cells(I, 6), 1, 5)
        nomville = Mid(Cells(I, 6), 7, 50)
        Cells(I, 6) = nomville
    Next
    
End Sub

Merci a bientot ^^
 

bqtr

XLDnaute Accro
Re : Séparer code postal / Ville en Macro

Bonjour Terek, jigagneur

Une autre façon de faire en passant par des tableaux, très rapide pour traiter un gros volume de données.

0,9 seconde pour séparer 39000 linges.
Il faut un espace entre le CP et la ville.

Code:
Sub Separe()

Dim tablo1, CP(), Ville()
Dim i As Long, j As Long, k As Long
't = Timer
Application.ScreenUpdating = False
j = 0
k = 0
tablo1 = Range("F2:F" & Range("F65536").End(xlUp).Row)

For i = 1 To UBound(tablo1)
  ReDim Preserve CP(j)
  ReDim Preserve Ville(k)
    CP(j) = Left(tablo1(i, 1), 5)
    Ville(k) = Right(tablo1(i, 1), Len(tablo1(i, 1)) - 6)
    j = j + 1
    k = k + 1
Next

Range("E2:E" & Range("F65536").End(xlUp).Row) = CP
Range("F2:F" & Range("F65536").End(xlUp).Row) = Ville
Application.ScreenUpdating = True
'MsgBox Timer - t
  
End Sub

Bonne journée
 

Discussions similaires

Statistiques des forums

Discussions
311 726
Messages
2 081 955
Membres
101 852
dernier inscrit
dthi16088