XL 2013 Extraire des données d'une cellule

elodieee

XLDnaute Nouveau
Bonjour,
Je cherche en vain une solution à mon problème sur excel.
Dans le cadre de mon travail, je reçois des extractions Outlook sur Excel.
Le corps du message en entier tiens dans une seule cellule. J'ai donc un texte immense dans chaque cellule.
Le travail consiste à extraire des mots clés de chaque mail.

Par exemple:
A1 B1 C3
email adresse 13/08/2019 Corps du message

Les messages ont toujours le même style de texte:

Message reçu ce jour
SENDER: BANQUE TRUC
DEVISES : EURO
MONTANT : 55
Dossier clos

Le but serait d'extraire uniquement les données SENDER, DEVISES et MONTANT dans une autre feuille afin de pouvoir établir un total pour chaque banque.

Je vous mets un exemple ce sera plus parlant !

Je vous remercie pour votre aide!

Bonne journée
 

Pièces jointes

  • EXXEMPLE.xlsx
    8.2 KB · Affichages: 17

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @elodieee, bienvenue sur XLD :),

Un essai par VBA. Cliquez sur le bouton HOP!
Le code est dans module1:
VB:
Sub test()
Dim t, s, i&, j&, n&

With Sheets("Feuil1")
  t = Range("c:c").Resize(Cells(Rows.Count, "c").End(xlUp).Row)
  ReDim v(1 To 3, 1 To 1)
  n = 1: v(1, n) = "SENDER": v(2, n) = "DEVISE": v(3, n) = "MONTANT"
  For i = 1 To UBound(t)
    s = Split(t(i, 1), Chr(10))
    If IsArray(s) Then
      For j = LBound(s) To UBound(s)
        If s(j) Like "SENDER : *" Then
          n = n + 1
          ReDim Preserve v(1 To 3, 1 To n)
          v(1, n) = Mid(s(j), Len("SENDER : "), 999)
          v(2, n) = Mid(s(j + 2), Len("DEVISE : "), 999)
          v(3, n) = CDbl(Replace(Mid(s(j + 1), Len("MONTANT : "), 999), ".", ","))
        End If
      Next j
    End If
  Next i
End With
With Sheets("RES")
  .Columns("a:c").Clear
  .Range("a1").Resize(UBound(v, 2), 3) = Application.Transpose(v)
  .Range("c1").Resize(UBound(v, 2)).NumberFormat = "0.00"
  .Select
End With
End Sub

edit : Bonsoir @zebanx :), @djidji59430 :)
 

Pièces jointes

  • elodieee-EXXEMPLE- v1.xlsm
    19.2 KB · Affichages: 25
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @zebanx ;) ,
Peux-tu m'expliquer cependant pourquoi tu utilises STP une boucle
If IsArray(s) then.... end if

Tu veux sans doute parler de condition au lieu de boucle ?
Imaginons que la cellule ne contienne aucun caractère Chr(10) (c'est le cas pour la ligne 1 et pour la ligne 2).
Dans ce cas, s = Split(t(i, 1), Chr(10)) ne renverrait pas un tableau mais une variable simple contenant tout le contenu de la cellule.
s n'étant pas dans ce cas un tableau, l'instruction For j = LBound(s) To UBound(s) provoquerait une erreur puisque LBound(s) n'existerait pas tout comme Ubound(s) n'existerait pas non plus.
Pour me prémunir contre cette erreur, je n'exécute la boucle que si s est vraiment un tableau d'où la condition...
 
Dernière édition:

elodieee

XLDnaute Nouveau
Bonjour @elodieee, bienvenue sur XLD :),

Un essai par VBA. Cliquez sur le bouton HOP!
Le code est dans module1:
VB:
Sub test()
Dim t, s, i&, j&, n&

With Sheets("Feuil1")
  t = Range("c:c").Resize(Cells(Rows.Count, "c").End(xlUp).Row)
  ReDim v(1 To 3, 1 To 1)
  n = 1: v(1, n) = "SENDER": v(2, n) = "DEVISE": v(3, n) = "MONTANT"
  For i = 1 To UBound(t)
    s = Split(t(i, 1), Chr(10))
    If IsArray(s) Then
      For j = LBound(s) To UBound(s)
        If s(j) Like "SENDER : *" Then
          n = n + 1
          ReDim Preserve v(1 To 3, 1 To n)
          v(1, n) = Mid(s(j), Len("SENDER : "), 999)
          v(2, n) = Mid(s(j + 2), Len("DEVISE : "), 999)
          v(3, n) = CDbl(Replace(Mid(s(j + 1), Len("MONTANT : "), 999), ".", ","))
        End If
      Next j
    End If
  Next i
End With
With Sheets("RES")
  .Columns("a:c").Clear
  .Range("a1").Resize(UBound(v, 2), 3) = Application.Transpose(v)
  .Range("c1").Resize(UBound(v, 2)).NumberFormat = "0.00"
  .Select
End With
End Sub

edit : Bonsoir @zebanx :), @djidji59430 :)


Super merci beaucoup!!!!!!!
C'est parfait :)
 

elodieee

XLDnaute Nouveau
Bonjour @elodieee, bienvenue sur XLD :),

Un essai par VBA. Cliquez sur le bouton HOP!
Le code est dans module1:
VB:
Sub test()
Dim t, s, i&, j&, n&

With Sheets("Feuil1")
  t = Range("c:c").Resize(Cells(Rows.Count, "c").End(xlUp).Row)
  ReDim v(1 To 3, 1 To 1)
  n = 1: v(1, n) = "SENDER": v(2, n) = "DEVISE": v(3, n) = "MONTANT"
  For i = 1 To UBound(t)
    s = Split(t(i, 1), Chr(10))
    If IsArray(s) Then
      For j = LBound(s) To UBound(s)
        If s(j) Like "SENDER : *" Then
          n = n + 1
          ReDim Preserve v(1 To 3, 1 To n)
          v(1, n) = Mid(s(j), Len("SENDER : "), 999)
          v(2, n) = Mid(s(j + 2), Len("DEVISE : "), 999)
          v(3, n) = CDbl(Replace(Mid(s(j + 1), Len("MONTANT : "), 999), ".", ","))
        End If
      Next j
    End If
  Next i
End With
With Sheets("RES")
  .Columns("a:c").Clear
  .Range("a1").Resize(UBound(v, 2), 3) = Application.Transpose(v)
  .Range("c1").Resize(UBound(v, 2)).NumberFormat = "0.00"
  .Select
End With
End Sub

edit : Bonjour @zebanx :), @djidji59430 :)

J'ai essayé de transposer votre code dans mon fichier réel, mais ça ne fonctionne pas...
Dans ma feuille 2 , je retrouve juste les entête
Bonjour @elodieee, bienvenue sur XLD :),

Un essai par VBA. Cliquez sur le bouton HOP!
Le code est dans module1:
VB:
Sub test()
Dim t, s, i&, j&, n&

With Sheets("Feuil1")
  t = Range("c:c").Resize(Cells(Rows.Count, "c").End(xlUp).Row)
  ReDim v(1 To 3, 1 To 1)
  n = 1: v(1, n) = "SENDER": v(2, n) = "DEVISE": v(3, n) = "MONTANT"
  For i = 1 To UBound(t)
    s = Split(t(i, 1), Chr(10))
    If IsArray(s) Then
      For j = LBound(s) To UBound(s)
        If s(j) Like "SENDER : *" Then
          n = n + 1
          ReDim Preserve v(1 To 3, 1 To n)
          v(1, n) = Mid(s(j), Len("SENDER : "), 999)
          v(2, n) = Mid(s(j + 2), Len("DEVISE : "), 999)
          v(3, n) = CDbl(Replace(Mid(s(j + 1), Len("MONTANT : "), 999), ".", ","))
        End If
      Next j
    End If
  Next i
End With
With Sheets("RES")
  .Columns("a:c").Clear
  .Range("a1").Resize(UBound(v, 2), 3) = Application.Transpose(v)
  .Range("c1").Resize(UBound(v, 2)).NumberFormat = "0.00"
  .Select
End With
End Sub

edit : Bonjour @zebanx :), @djidji59430 :)

J'ai tenté de coller votre code dans mon fichier réel, et cela ne fonctionne pas...
Ca me rapporte bien SENDER MONTANT DEVISE dans la feuille 2 , mais c'est tout, pas d'autres infos...
Je ne connais pas VBA, pouvez juste me dire où se trouvent les infos que je dois modifier pour l'adapter au style de mon fichier?
Je vous remercie beaucoup !!!

Bonne journée :cool:
 

Amilo

XLDnaute Accro
Re,
S'agit-il également d'une version Excel 2013 au travail ?
Sinon, Power query est un complément téléchargeable pour les versions 2010 et 2013 mais déjà intégré à partir d'Excel 2016
Je pourrais joindre une doc si vous voulez pour le téléchargement de power query mais à voir avant avec votre responsable pour l'autorisation
Sinon, c'est vraiment dommage de s'en priver
Cordialement
 
Dernière édition:

Statistiques des forums

Discussions
311 707
Messages
2 081 734
Membres
101 809
dernier inscrit
HADER2024