Extraire les données d'une cellule

FaridP

XLDnaute Occasionnel
Bonsoir à toutes et à tous,

J'ai reçu un fichier dont toutes les données sont à la suite dans une cellule et j'aimerais les récupérer sous un format exploitable c'est à dire une donnée par cellule et par ligne.

Pour information, ce souci est présent sur 31 lignes différentes et je ne peux pas multiplier les étapes pour arriver à mes fins donc si quelqu'un à une solution quasi automatique, j'avoue que ça m'arrange. :);)

Je joins un aperçu du problème (onglet "Reçu") et un aperçu de ce que j'aimerais obtenir (onglet "Attendu").

Merci pour votre aide et votre temps et bonne soirée à tous,

Farid
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Bonjour

je vois pas bien le lien entre la feuille "Recu" et la feuille "attendu"...
mais à tout hasard

dans la feuille "Recu"
sélectionner la colonne A
données - convertir - délimité - virgule - OK
 

Paf

XLDnaute Barbatruc
bonjour,

un essai macro:
VB:
Sub EnColonne()
Dim T, DL As Long, Plage As Range, CC As Range
Application.ScreenUpdating = False
DL = 1

With Worksheets("Reçu")
.Columns(2).NumberFormat = "@"
Set Plage = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

With Worksheets("Attendu")
For Each CC In Plage
    T = Split(CC.Value, "', ")
    .Range("B" & DL).Resize(UBound(T, 1), 1) = Application.Transpose(T)
    DL = .Range("B" & Rows.Count).End(xlUp).Row + 1
Next
End With
Application.ScreenUpdating = True

End Sub
il reste quelques cellules avec " ;" il faudrait affiner; demain ...

A+

Edit : bonsoir vgendron solution effectivement plus simple !

re edit : sur mon antique version la conversion ne peut être faite qu'en ligne .
 
Dernière édition:

FaridP

XLDnaute Occasionnel
Bonsoir,

Merci pour ton aide.

J'ai envisagé cette solution mais elle m'oblige à recommencer l'opération 31 fois et de supprimer les apostrophes ensuite. C'est ce que je cherche à éviter.

En tout cas, je te remercie pour ton temps.

Bonne soirée,

Farid
 

FaridP

XLDnaute Occasionnel
Bonsoir Paf,

Je vais tester ça mais ne t'embête pas avec les ";" car je pars de tellement loin que c'est un détail et je pourrai les chasser facilement.

Merci beaucoup !

Farid
 

vgendron

XLDnaute Barbatruc
avec ce code alors..
VB:
Sub Macro1()
'
' Macro1 Macro
'
Dim tablo() As Variant
Dim res As Variant
Application.ScreenUpdating = False

With Sheets("Reçu")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tablo = .Range("A1:A" & fin).Value
End With
For i = LBound(tablo, 1) To UBound(tablo, 1)
    res = Split(tablo(i, 1), ",")
    For j = LBound(res) To UBound(res)
        res(j) = WorksheetFunction.Substitute(WorksheetFunction.Substitute(WorksheetFunction.Substitute(res(j), "'", ""), "(", ""), ")", "")
    Next j
    Sheets("Reçu").Range("A" & i).Resize(1, UBound(res)) = res
Next i
Application.ScreenUpdating = True
End Sub
 

FaridP

XLDnaute Occasionnel
Vgendron, Paf, un grand merci à vous, c'est top.

Sans vouloir exagérer, j'ai oublié un paramètre important : il y a une colonne avec une référence que je dois aussi récupérer (c.f. : exemple), pensez-vous que c'est possible ?

Sincèrement désolé, j'aurais pu et dû tout mettre dès le départ. :(
 

Fichiers joints

FaridP

XLDnaute Occasionnel
La solution de Paf donne exactement le résultat souhaité.
Si je pouvais en plus récupérer la valeur de la colonne B associée, je pourrais de nouveau dormir. :)
 

Paf

XLDnaute Barbatruc
re,

avec la prise en compte de la colonne B

VB:
EnColonne()
Dim TT, T, DL As Long, i As Long
Application.ScreenUpdating = False

DL = 1
With Worksheets("Reçu")
TT = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

With Worksheets("Attendu")
For i = LBound(TT, 1) To UBound(TT, 1)
    T = Split(TT(i, 1), "', ")
    .Range("B" & DL).Resize(UBound(T, 1) + 1, 1) = Application.Transpose(T)
    .Range("C" & DL).Resize(UBound(T, 1) + 1, 1) = TT(i, 2)
    DL = .Range("B" & Rows.Count).End(xlUp).Row + 1
Next
End With
Application.ScreenUpdating = True
End Sub
Bonne suite
 

FaridP

XLDnaute Occasionnel
re,

avec la prise en compte de la colonne B

VB:
EnColonne()
Dim TT, T, DL As Long, i As Long
Application.ScreenUpdating = False

DL = 1
With Worksheets("Reçu")
TT = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

With Worksheets("Attendu")
For i = LBound(TT, 1) To UBound(TT, 1)
    T = Split(TT(i, 1), "', ")
    .Range("B" & DL).Resize(UBound(T, 1) + 1, 1) = Application.Transpose(T)
    .Range("C" & DL).Resize(UBound(T, 1) + 1, 1) = TT(i, 2)
    DL = .Range("B" & Rows.Count).End(xlUp).Row + 1
Next
End With
Application.ScreenUpdating = True
End Sub
Bonne suite
Hello Paf,

C'est juste top, merci beaucoup ! Exactement comme je le souhaitais.

Excellente fin de journée à toi et encore merci. ;)
 

Discussions similaires


Haut Bas