Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules excel

[CAPRI_456]

Bonsoir le Forum,

J'ai récupéré le contenu (corps/body) d'un Email dans une cellule excel.
Là pas de soucis. Cependant le texte se présente comme suit dans la cellule

bonjour(carré)
OSD/240/DFF(carré)
description/poids/volume(carré)
123444/ULM (carré)
Merci(carré)

Tout ce texte a été récupéré dans une cellule "D2"
Donc le texte est en fin de ligne marqué par un "carré" qui corresponde je pense à un "retour chariot"
et dans une ligne on à des séparateurs/


But à atteindre : en VBA envoyer chaque élément séparé soit par le "carré "soit par "/" dans les cellules
"E2", "F2", "G2" , etc ......

Fichier joint
Merci pour votre aide

CAPRI_456

 

[phlaurent55]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Bonjour Capri,

ton fichier en retour

à+
Philippe

 

[CAPRI_456]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Bonjour le Forum, PhLaurent55,

Philippe, Merci pour ce retour rapide.
J'ai examiné le résultat:
-Ok, il me redistribue le texte de la cellule D2 à chaque "retour chariot"

Mais je souhaiterais également qu'il le fasse vers chaque cellule à droite à chaque séparateur "/"

Merci


CAPRI_456

 

[phlaurent55]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Re,

peut-être avec ceci:

Sub Macro1()
' boucle dans la colonne D
For i = 2 To Range("D65535").End(xlUp).Row
'boucle sur la longueur du texte de la cellule
texte = Cells(i, 4).Value
debut = 1
colonne = 5
For j = 1 To Len(Cells(i, 4))
    If Asc(Mid(Cells(i, 4), j, 1)) = 10 Then
        Cells(i, colonne).Value = Mid(texte, debut, j - debut)
        colonne = colonne + 1
        debut = j
    End If
    If Asc(Mid(Cells(i, 4), j, 1)) = 47 Then
        Cells(i, colonne).Value = Mid(texte, debut, j - debut)
        colonne = colonne + 1
        debut = j + 1
    End If
        
Next j
Next i
End Sub

à+
Philippe

 

[CAPRI_456]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Bonjour, le Forum, Ph Laurent55,

Philippe,

je teste cela et reviens à toi.

Merci

 

[CAPRI_456]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Bonjour le Forum, Phlaurent55,

Merci Ph pour la méthode, cela correspond parfaitement à mes besoins..

Juste un petit élément, comment enlever le "carré" qui se retrouve chaque fois à la fin dans les colonnes E à ...... après éclatement ?
Je puis imaginer qu'il s'agit d'éliminer le caractère ascii "10" mais je ne vois pas comment .

Bien à toi
Et Merci

CAPRI_456

 

[CAPRI_456]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Le Forum,

VOici ce que j'ai touvé

Sub ElimineLesCarres()

Dim c
For Each c In Range("E2:Q2")
c.Replace Chr(13), ""
Next c

End Sub

Cependant il faudrait pouvoir étendre cette action à tous les champs non vides
ou plutôt et plus pratique :après chaque importation d'emails dans mon excel via le (Module4)
---- 1. lancer le Module 2 pour répartir dans les colonnes à droite E2.... à ..... dernière col utilisée
---- 2. lancer le Module 3 pour éliminer les carrés ( Chr13) à droite E2.... à ..... dernière col utilisée

 

[JNP]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Bonsoir le fil 🙂,
Une autre façon de voir les choses 😛

Option Base 1
Sub test()
Dim Tableau1, Tableau2, Tableau()
Dim I As Integer, J As Integer, K As Integer, L As Integer
For I = 2 To Range("D65535").End(xlUp).Row
L = 1
Tableau1 = Split(Cells(I, 4).Value, Chr(10))
For J = LBound(Tableau1) To UBound(Tableau1)
Tableau2 = Split(Tableau1(J), "/")
For K = LBound(Tableau2) To UBound(Tableau2)
ReDim Preserve Tableau(L)
Tableau(L) = Tableau2(K)
L = L + 1
Next K
Next J
Cells(I, 5).Resize(, L - 1).Value = Tableau
Next I
End Sub

Par contre, l'éclatement de la date, c'est pas top 🙄...
Bonne soirée 😎

 

[CAPRI_456]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Bonsoir le Forum, Phlaurent55,JNP,

JNP merci pour cette approche, je l'ai testée, = Resultats identique à la proposition de Phlaurent55

Merci

Pour éliminer les carrés à chaque importation des E-mails
j'appelle la macro du mod4 "Eclatement" qui elle même appelle la macro du mod 3 "ElimineLes Carrés"

Sub Macro1()
' boucle dans la colonne D
For I = 2 To Range("D65535").End(xlUp).Row
'boucle sur la longueur du texte de la cellule
texte = Cells(I, 4).Value
debut = 1
colonne = 5
For J = 1 To Len(Cells(I, 4))
If Asc(Mid(Cells(I, 4), J, 1)) = 10 Then
Cells(I, colonne).Value = Mid(texte, debut, J - debut)
colonne = colonne + 1
debut = J
End If
If Asc(Mid(Cells(I, 4), J, 1)) = 47 Then
Cells(I, colonne).Value = Mid(texte, debut, J - debut)
colonne = colonne + 1
debut = J + 1
End If

Next J
ElimineLesCarres 'macro qui élimine les carrés à la fin de chaque cellule
Next I

End Sub

Merci à vous tous pour cette rapide réponse.

CAPRI_456

 

[JNP]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Re 🙂,

je l'ai testée, = Resultats identique à la proposition de Phlaurent55

Pas tout à fait d'accord vu qu'elle élimine les Chr(10), ce qui n'est pas le cas de celle de Philippe 🙄...
Par contre, effectivement, il reste des Chr(13) (tabulation) et des espaces non voulus avant ou après 😱...
Il suffit juste de modifier cette ligne

Tableau(L) = Trim(Replace(Tableau2(K), Chr(13), ""))

et tu peux te passer de ta macro Eliminelescarrés 😛...
Bonne suite 😎

 

[CAPRI_456]

Re : Eclater le texte d'un mail déjàimporté dans une cellule vers plusieurs cellules

Bonjour, le Forum,Phlaurent55, JNP,😱

AUTANT POUR Moi

JNP, Tu as parfaitement raison...
Une procédure au lieu de deux....
L'important, j'ai , ...le Forum à maintenant deux approches...

Merci à tous les deux
Bonne journée

CAPRI_456