Séparer code postal / Ville en Macro

[Terek]

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

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]

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

 

[jigagneur]

Re : Séparer code postal / Ville en Macro

oups petite erreur sur nomville

nomville=mid(cells(I,6),7,10) et non cells(I,5)......

 

[Terek]

Re : Séparer code postal / Ville en Macro

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

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]

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.

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