séparer donnes d'une cellule

Le
jip
Bonjour
J'ai un certain nombre de fichiers sous cette forme, la suite d'un copi=
er-coller d'un logiciel pourri
http://cjoint.com/?CDko07YAz8S
Toutes les donnes sont dans une seule cellule et non sous forme de table=
au.
je souhaite sparer le contenu de cette "cellule" chaque fois qu'il y=
a l'anne ou la mention s.d. et obtenir un tableau de x lignes correspon=
dant aux x donnes contenues.
Bien entendu je n'ai pas qu'un tableau traiter sinon ce serait dj=
fait manuellement.
Merci d'avance si vous avez une ide.
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #25330412
Bonjour,

Essaie cette petite macro en supposant que les coupures
soient faites au bon endroit :
'------------------------------------
Sub test()
Dim X As Variant

With Worksheets("Feuil1")
X = Split(.Range("A3"), "/")
.Range("C1").Resize(UBound(X) + 1) = Application.Transpose(X)
End With
End Sub
'------------------------------------


MichD
---------------------------------------------------------------
une idée.
h2so4
Le #25338162
Bonnjour,

En reprenant l'idée de MichD et en essayant d'imaginer le résultat
auquel tu souhaites arriver et sur base de l'échantillon que tu as
donné
voici une macro qui devrait t'aider.

Sub test()
Dim X As Variant

' la ligne à transposer est en A1
' resultat en colonnes B1:D?



With Worksheets("Feuil1")
'
' correction de quelques erreurs
' détection des blancs qui sont des séparateurs d'inforamtion des
autres
' replacés par ù
' détection des lignes (identification par £)
'
.Range("A1").Replace What:="°", replacement:="° "
.Range("A1").Replace What:=" ", replacement:=" "
.Range("A1").Replace What:="supl", replacement:="suppl"
.Range("A1").Replace What:="suppl au n° ", _
replacement:="supplùauùn°ù"
.Range("A1").Replace What:="suppl du n° ", _
replacement:="supplùduùn°ù"
.Range("A1").Replace What:=" BM", replacement:="£BM"
.Range("A1").Replace What:=" Cote", replacement:="£Cote"
.Range("A1").Replace What:="BM ", replacement:="BMù"
.Range("A1").Replace What:=" /", replacement:="ù/"
.Range("A1").Replace What:="/ ", replacement:="/ù"
.Range("A1").Replace What:=" trimestre ", _
replacement:="ùtrimestre"
.Range("A1").Replace What:=" de parution", _
replacement:="ùdeùparution"
' éclatement des lignes
X = Split(.Range("A1"), "£")
Z = UBound(X) + 1
.Range("B1").Resize(Z) = Application.Transpose(X)

' on considère les 2 premiers blancs trouvés comme séparateurs

For Each c In .Range("B1:B" & Z)
txt = c.Value
c.Value = Replace(txt, " ", ";", , 2)
Next

' on eclate chaque ligne sur les colonnes B,C,D
.Range("B1:B" & Z).TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, _
Semicolon:=True

' on replace les ù par des blancs

.Range("B1:E" & Z).Replace What:="ù", replacement:=" "

' recherche du nom de la revue

For i = Z To 2 Step -1
If .Cells(i, 2) = "Cotes" Then
s = .Cells(i - 1, 4)
ns = ""
For j = Len(s) To 1 Step -1
k = Mid(s, j, 1)
If k < "0" Or k > "9" Then
ns = k & ns
Else
.Cells(i, 2) = "Revue : " & ns
.Cells(i, 3) = ""
.Cells(i, 4) = ""
.Cells(i - 1, 4) = Left(s, Len(s) - Len(ns))
i = i - 1
Exit For
End If
Next j
End If
Next i
End With
End Sub

--
h2so4
ca PAN
pique DORA
.
Publicité
Poster une réponse
Anonyme