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.
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.
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.
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
.