Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel séparer donnes d'une cellule

séparer donnes d'une cellule

2 réponses
Avatar
jip
Bonjour
J'ai un certain nombre de fichiers sous cette forme, =E0 la suite d'un copi=
er-coller d'un logiciel pourri...
http://cjoint.com/?CDko07YAz8S
Toutes les donn=E9es sont dans une seule cellule et non sous forme de table=
au.
je souhaite s=E9parer le contenu de cette "cellule" =E0 chaque fois qu'il y=
a l'ann=E9e ou la mention s.d. et obtenir un tableau de x lignes correspon=
dant aux x donn=E9es contenues.
Bien entendu je n'ai pas qu'un tableau =E0 traiter sinon ce serait d=E9j=E0=
fait manuellement.
Merci d'avance si vous avez une id=E9e.
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
MichD
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.
Avatar
h2so4
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
.