Discussion :

[nfenouil]

Bonjour à tous,

Je dois retravailler un fichier XLS contenant plusieurs millier d'adresse pour les mettre à la norme postale.
Actuellement les adresse sont saisies en 3 colonnes :
Adresse / Code postal / Ville
Je dois les passer sur 6 colonnes :
Adresse 1 / Adresse 2 / Adresse 3 / Code postal / Ville

Chaque champs adresse doit comporter au max 38 caractères, et bien sur la découpe ne doit pas se faire au milieu d'un mot...
Je cherche donc une formule qui me permettrait de découper à chaque "espace" se trouvant avant le 38em caractère.

Par exemple :
"Immeuble le Pacore, 3 rue Antoine et Henri Maurras" doit devenir "Immeuble le Pacore, 3 rue Antoine et" + "Henri Maurras"

Cela fait 3h que je planche la dessus... je craque !
Est-ce que l'un d'entre vous à une idée ?

[JPierreM]

Bonjour,

Le code ci-dessous découpe la chaine située en A1 en sous chaines de 38 caractères maxi sans couper les mots. Les sous chaines sont placées en A2, A3 etc. A adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Test()
Dim depart As Integer
Dim texte As String
Dim nouvellePhrase As String
 
   MsgBox "Découpe une phrase en phrases de 38 caractères maxi" _
   & Chr(13) & "sans couper les mots"
    depart = 2
    texte = [A1]
 
    Do While Len(texte) >= 38
        nouvellePhrase = Left(texte, 38)
        nouvellePhrase = InStrRev(nouvellePhrase, " ")
        Cells(depart, 1) = Left(texte, nouvellePhrase - 1)
        texte = Mid(texte, nouvellePhrase + 1, 64536)
        depart = depart + 1
    Loop
 
    Cells(depart, 1) = texte
 End Sub

JP

[BlueMonkey]

Bonjour,

La solution la plus simple est d'utiliser la macro suivante pour retraiter le fichier.

1) Insérer 3 colonnes vide après la colonne d'adresse actuelle
(il y a une colonne de "trop" qu'on supprimera après le traitement.
Elle ne servira que dans le cas où il y aurait des adresses qui ne pourrait pas être séparé en 3 champs de 38 caractères max.

2) Sélectionner la première cellule de la colonne adresse contenant une adresse à dé-concaténer.

3) touche <ALT> + <F11> pour ouvrir l'éditeur VBA.

4) Menu Insertion -> Module.

5) Copier/Coller le code suivant le module.

6) Cliquer sur la ligne Sub SplitInto38CharMax() puis cliquer sur le bouton Play de l'Editeur VBA.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub SplitInto38CharMax()
    SplitIntoNbCharMax
End Sub
 
Sub SplitIntoNbCharMax(Optional nbcharmax As Integer = 38)
 
    Dim nbLigne As Long: nbLigne = ActiveCell.End(xlDown).Row
    Dim fisrtcol As Long: fisrtcol = ActiveCell.Column
 
    Dim col As Long
    Dim li As Long
    Dim val As String
 
    For li = ActiveCell.Row To nbLigne
        col = fisrtcol
        val = Cells(li, col).Value
        Do
            Dim result As String
            result = GetNextPhraseAtLessThanNbChar(val, nbcharmax)
            Cells(li, col) = result
            col = col + 1
        Loop While (Len(val) > 1)
    Next li
End Sub
 
Private Function GetNextPhraseAtLessThanNbChar(ByRef phraseToSplit As String, nbcharmax As Integer) As String
    Dim LastSpacePos As Integer
    Dim currentSpacePos As Integer
    LastSpacePos = -1
    currentSpacePos = 0
    phraseToSplit = Trim(phraseToSplit)
    Do
        currentSpacePos = InStr(currentSpacePos + 1, phraseToSplit, " ")
        If (currentSpacePos > nbcharmax) Then Exit Do
        If currentSpacePos > LastSpacePos Then LastSpacePos = currentSpacePos
    Loop While (currentSpacePos > 0)
 
    If (LastSpacePos < 1) Or (Len(phraseToSplit) < nbcharmax) Then
        GetNextPhraseAtLessThanNbChar = phraseToSplit
        phraseToSplit = ""
    Else
        GetNextPhraseAtLessThanNbChar = Left(phraseToSplit, LastSpacePos - 1)
        phraseToSplit = Mid(phraseToSplit, LastSpacePos + 1)
    End If
 
End Function

[Edit] J'ai été moins rapide que JPierreM

[Marc-L]

Bonjour,

un autre exemple via une fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function Adresse38(ByVal Adr$) As String()
         ReDim AD$(2):   AD(0) = Application.Trim(Adr)
 
         Do While Len(AD(N%)) > 38
             P = InStrRev(AD(N), " ", 38)
             If N < 2 Then AD(N + 1) = Mid$(AD(N), P + 1)
             AD(N) = Left$(AD(N), P - 1):   N = N - (N < 2)
         Loop
 
         Adresse38 = AD
End Function
 
 
Sub Demo()
    Adresse$ = "Immeuble le Pacore,         3 rue Antoine et Henri Maurras"
    [A9].Resize(, 3) = Adresse38(Adresse)
End Sub

nfenouil, si tu as tant de lignes à traiter, en indiquant la cellule du coin supérieur gauche de la plage à traiter
ainsi que la destination, par dessus ou dans une autre feuille … je pourrais te proposer un code à l'exécution rapide.

Edit : modification pour simplifier la fonction …


__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[Marc-L]

P'ite variante coupant d'abord à la virgule (plus joli) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function Adresse38(ByVal Adr$) As String()
         ReDim AD$(2):   AD(0) = Application.Trim(Adr)
 
         Do While Len(AD(N%)) > 38
             P = InStrRev(AD(N), ",", 38):  If P = 0 Then P = InStrRev(AD(N), " ", 38)
             If N < 2 Then AD(N + 1) = LTrim$(Mid$(AD(N), P + 1))
             AD(N) = RTrim$(Left$(AD(N), P)):   N = N - (N < 2)
         Loop
 
         Adresse38 = AD
End Function
 
 
Sub Demo()
    Adresse = Array("Immeuble le Pacore,        3 rue Antoine et Henri Maurras", _
                    "Immeuble le Pacore         3 rue Antoine et Henri Maurras")
 
    For N& = 0 To UBound(Adresse)
        Cells(11 + N, 1).Resize(, 3) = Adresse38(Adresse(N))
    Next
End Sub

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …


__________________________________________________________________________________________
Le mec qui a convaincu les aveugles de porter des lunettes de soleil était quand même un sacré commercial !

[nfenouil]

Bonjour à tous,

Merci infiniment pour vos réponses !!! Grace vous j'ai pu retraiter d'un coup les 11 000 lignes d'adresse de mon fichier !

[Invité]

Bonjour

Je n'ai pas testé les codes, mais si ton exemple :

"Immeuble le Pacore, 3 rue Antoine et Henri Maurras" doit devenir "Immeuble le Pacore, 3 rue Antoine et" + "Henri Maurras"

Est-ce que tu souhaites, je peux te dire que ce n'est pas du tout conforme aux normes postales.

Les professionnels utilisent des logiciels de RNVP (remise aux normes), et que les algorithmes sont autrement plus compliqués.

C'était juste une petite appartée.

Philippe

[nfenouil]

Bonjour Philippe,
J'ai bien conscience que "Immeuble le Pacore, 3 rue Antoine et" + "Henri Maurras" ne colle pas vraiment avec les normes postales par contre cela correspond bien à la commande de mon utilisateur.
En tout cas merci pour l'info, je ne savais pas qu'il existait des logiciels de RNVP

[Invité]

Re

Si ton client utilise ce fichier pour faire un Mailing il risque d'avoir un taux de retour important, c'est ce que l'on appelle les NPAI (n'habite pas à l'adresse indiquée).

Je pense que tu risques d'avoir des soucis avec ton client et je peux te le dire en connaissance de cause, c'est une grande partie de mon métier.

Philippe