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 données sont dans une seule cellule et non sous forme de table=
au.
je souhaite séparer le contenu de cette "cellule" à chaque fois qu'il y=
a l'année ou la mention s.d. et obtenir un tableau de x lignes correspon=
dant aux x données contenues.
Bien entendu je n'ai pas qu'un tableau à traiter sinon ce serait déjà=
fait manuellement.
Merci d'avance si vous avez une idée.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
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