Découper un nom de son code postal

[maval]

Bonjour

Je souhaiterai découpé le nom du code postal en sachant qu'il y a environ 150 lignes par colonne

en VBA si possible.

Je joint un exemple

Merci d'avance

Cordialement

Maval

 

[maval]

Re : Découper un nom de son code postal

Re,

J'ai un message d'erreur

" la méthode Range de l'objet Worksheet a échoué" et sa me surligne

Range("B:B,E:E,I:I,L:L,O:O,R:R").Delete Shift:=xlToLeft

@+

 

[jpb388]

Re : Découper un nom de son code postal

Bonjour
aucun problème chez moi
regarde si tu as bien tout rapporter
et si tu trouve pas met ton classeur

 

[david84]

Re : Découper un nom de son code postal

Bonjour,
une fonction personnalisée à tester :

Function découpe(c As String) As String
Dim s
If c Like "*(*" Then
    s = Split(c, "(")
    découpe = Trim(s(0))
End If
End Function

A+

 

[laetitia90]

Re : Découper un nom de son code postal

re,🙂🙂🙂🙂🙂
peut être que le pb.. viens que l'ami jpb passe les colonnes en, L1C1 & non en a b c,ect... de plus passer par un array column bien plus simple cela evite de chaque fois rappel macro


Col = 2
OperationDeDécoupage Col
ect...

 

[jpb388]

Re : Découper un nom de son code postal

Bonsoir à tous,Laetitia90
Laetitia90 tu peux montrer un exemple de ta manip
merci d'avance

 

[laurent950]

Re : Découper un nom de son code postal

Bonsoir le Forulm

Option Base 1
Sub Decompose()
Dim T As Variant
fin = Range("c65536").End(xlUp).Row
Range(Cells(3, 5), Cells(fin, 6)).Clear
T = Range(Cells(3, 3), Cells(fin, 3)).Value
ReDim Preserve T(1 To 6, 1 To 3)
For i = LBound(T) To UBound(T)
x = Split(T(i, 1), "(")
T(i, 3) = Left(x(1), Len(x(1)) - 1)
T(i, 2) = Left((T(i, 1)), Len((T(i, 1))) - Len(x(1)) - 2)
Next i
For i = 2 To 3
 Cells(3, i + 3).Resize(UBound(T, 1)) = Application.Index(T, , i)
 Next i
End Sub

Laurent

 

[david84]

Re : Découper un nom de son code postal

Bonjour,
suite à mon 1er message, pour la commune :

Function Commune(c As String) As String
Dim s
If c Like "*(*" Then
    s = Split(c, "(")
    Commune = Trim(s(0))
End If
End Function

Pour le code postal :

Function Code_postal(c As String) As String
Dim s
If c Like "*(*" Then
    s = Split(c, "(")
    Code_postal = Replace(Trim(s(1)), ")", "")
End If
End Function

Saches que tu obtiens facilement les mêmes résultats sans passer par du VBA mais puisque tu sembles y tenir...
A+

 

[JNP]

Re : Découper un nom de son code postal

Bonjour le fil 🙂,
Une solution sans formule ni VBA :
http://www.galichon.com/codesgeo/data/insee.zip
et s'il ne te convient pas (il est en majuscules), tu as une mine de lien :
Code postal insee coordonées GPS WGS84 longitude latitude des villes en France - PlaceOweb Dotclear
Bonne suite 😎

 

[JNP]

Re : Découper un nom de son code postal

Re 🙂,
Mais si tu aimes le VBA, une solution en RegExp + Tableaux qui remets tout dans les colonnes A et B

Sub Test()Dim Tablo1(), Tablo2(), I As Integer, J As Integer, K As Integer, DerLigne As Integer, DerColonne As Integer
DerColonne = Cells(2, Columns.Count).End(xlToLeft).Column
With CreateObject("vbscript.regexp")
    For K = 1 To DerColonne
        If Application.WorksheetFunction.CountBlank(Columns(K)) <> Rows.Count Then
            DerLigne = Cells(Rows.Count, K).End(xlUp).Row
            ReDim Preserve Tablo1(DerLigne + J)
            ReDim Preserve Tablo2(DerLigne + J)
            For I = 1 To DerLigne
                .Global = False
                .Pattern = "\d+?[0-9AB]\d{3}"
                If .Test(Cells(I, K)) Then
                    Tablo1(J) = .Execute(Cells(I, K))(0)
                    .Pattern = "[^(]*"
                    Tablo2(J) = Trim(.Execute(Cells(I, K))(0))
                    J = J + 1
                End If
            Next I
        End If
    Next K
End With
Cells.Clear
Range("A1:A" & J).Value = Application.Transpose(Tablo1)
Range("B1:B" & J).Value = Application.Transpose(Tablo2)
Range("A:B").Columns.AutoFit
End Sub

Bonne suite 😎

 

[david84]

Re : Découper un nom de son code postal

Bonjour Jean-Noël🙂,
content de te croiser !
Pourquoi passer par 2 motifs et 2 execute ?
A moins d'avoir loupé quelque chose (ce qui est possible), si je reprends ton idée, on peut en économiser un :

Sub Test()
Dim Tablo1(), Tablo2(), I As Integer, J As Integer, K As Integer, DerLigne As Integer, DerColonne As Integer
DerColonne = Cells(2, Columns.Count).End(xlToLeft).Column
With CreateObject("vbscript.regexp")
    For K = 1 To DerColonne
        If Application.WorksheetFunction.CountBlank(Columns(K)) <> Rows.Count Then
            DerLigne = Cells(Rows.Count, K).End(xlUp).Row
            ReDim Preserve Tablo1(DerLigne + J)
            ReDim Preserve Tablo2(DerLigne + J)
            For I = 1 To DerLigne
                .Pattern = "(.+)\s\((\d{5})\)"
                Set Matches = .Execute(Cells(I, K))
                If .Test(Cells(I, K)) Then
                    Tablo1(J) = Matches.Item(0).submatches(0)
                    Tablo2(J) = Matches.Item(0).submatches(1)
                    J = J + 1
                End If
            Next I
        End If
    Next K
End With
Cells.Clear
Range("A1:A" & J).Value = Application.Transpose(Tablo1)
Range("B1:B" & J).Value = Application.Transpose(Tablo2)
Range("A:B").Columns.AutoFit
End Sub

A+

 

[JNP]

Re : Découper un nom de son code postal

Re 🙂,
Certainement David, par contre, n'oublie pas dans ton masque la Corse (2A et 2B) 🙄...
Bonne suite 😎

 

[david84]

Re : Découper un nom de son code postal

Re

Certainement David, par contre, n'oublie pas dans ton masque la Corse (2A et 2B) ...

En fait, c'était surtout pour le plaisir de te croiser !
Concernant le 2A et 2B, cela est à prendre en compte au sujet des départements et des plaques d'immatriculation mais pas au niveau des codes postaux à ma connaissance...
regarde ici.
A+

 

[maval]

Re : Découper un nom de son code postal

Bonjour JNP, David

Excuser moi de ne pas avoir répondu avant mais j’étais absent
J'ai regardé avec attention super...! si je peut me permettre de vous demandez juste une petite modif, est-il possible au lieu d'avoir tous la liste sur deux colonnes "A et B" de l'avoir sur 4 colonnes

Merci d'avance

Cordialement

Maval

 

[david84]

Re : Découper un nom de son code postal

Bonjour,
peut-être comme cela :

Sub Test()
Dim Tablo1(), Tablo2(), I As Integer, J As Integer, K As Integer, DerLigne As Integer, DerColonne As Integer
DerColonne = Cells(2, Columns.Count).End(xlToLeft).Column
With CreateObject("vbscript.regexp")
    For K = 1 To DerColonne
        If Application.WorksheetFunction.CountBlank(Columns(K)) <> Rows.Count Then
            DerLigne = Cells(Rows.Count, K).End(xlUp).Row
            ReDim Preserve Tablo1(DerLigne + J)
            ReDim Preserve Tablo2(DerLigne + J)
            For I = 1 To DerLigne
                .Pattern = "(.+)\s\((\d{5})\)"
                If .Test(Cells(I, K)) Then
                Set Matches = .Execute(Cells(I, K))
                    Tablo1(J) = Matches.Item(0).submatches(0)
                    Tablo2(J) = Matches.Item(0).submatches(1)
                    J = J + 1
                End If
            Next I
        End If
    Next K
End With
Cells.Clear
Range("A1:A" & J).Value = Application.Transpose(Tablo1)
Range("B1:B" & J).Value = Application.Transpose(Tablo2)
Range("A" & J \ 2 + 1 & ":B" & J).Copy Destination:=Range("C1")
Range("A" & J \ 2 + 1 & ":B" & J).Clear
Range("A:D").Columns.AutoFit
End Sub

A+

 

[maval]

Re : Découper un nom de son code postal

Bonjour David

Merci super je te souhaite une bonne journée

Maval