Conversion fichier CSV

Version imprimable

Bonjour.
Mon problème est le suivant:
j'ai dans feuill1 des données au format CSV des enregistrements de largeur fixe du genre: en A1 j'ai "DATE HEURE ETAT DUREE" et je voudrais éclater le contenu de ces cellules en 4 colonnes comme ceci: en A1 "DATE" en B1"HEURE" en C1 "ETAT" et en D1 "DUREE" puis mettre le résultat dans une nouvelle feuille.
En le faisant avec le menu données-Convertir ça marche nickel par contre quant j'automatise par macro VBA, cela ne marche pas. voici le code:
Code:

1 2 3 4 Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(10, 1), Array(21, 1), Array(51, 1)), _ TrailingMinusNumbers:=True

07/07/2009, 09h08
ouskel'n'or

Bonjour,
Je te mets une URL où tu trouveras "une" solution utilisée pour séparer le nom d'un prénom placés dans une même cellule.
Le problème des majuscules/minuscules ne se pose pas pour toi mais qui peut le plus peut le moins... Et puis rien ne t'empêche de simplifier... ;)
http://www.developpez.net/forums/m1940803-8/
Bonne journée
07/07/2009, 09h17
LeForestier

Bonjour, bonjour Ousk,
Pourrais-tu montrer le libellé d'un enrégistrement avant séparation.
A+
07/07/2009, 10h26
ouskel'n'or
Désolé, zakou76, j'avais mal lu ta question. Teste ça sans utiliser les arrays inutiles ici si le séparateur est bien un espace.
Code:

1 2 3 Columns("A").Select Selection.TextToColumns DataType:=xlDelimited, _ ConsecutiveDelimiter:=True, Space:=True
(Bonjour l'homme des bois ;) )

Salut,
Peut etre, vite fait, à ameliorer :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Dim DEP
DEP = 1
Dim POS1
Dim POS2
Dim POS3
SEP = " "' si separateur espace
ETUDE = Cells(1, 1)'cellule etudiée
DEPART:
For CHERCH = DEP To Len(ETUDE) + 1
 
If Mid(ETUDE, CHERCH, 1) = SEP And POS1 = "" Then
POS1 = CHERCH
DEP = CHERCH + 1
GoTo DEPART
End If
 
If Mid(ETUDE, CHERCH, 1) = SEP And POS2 = "" Then
POS2 = CHERCH
DEP = CHERCH + 1
GoTo DEPART
End If
 
If Mid(ETUDE, CHERCH, 1) = SEP And POS3 = "" Then
POS3 = CHERCH
DEP = CHERCH + 1
GoTo DEPART
End If
 
Next CHERCH
'cellules d'arrivées
Cells(2, 1) = Mid(ETUDE, 1, POS1)
Cells(3, 1) = Mid(ETUDE, POS1 + 1, POS2 - POS1)
Cells(4, 1) = Mid(ETUDE, POS2 + 1, POS3 - POS2)
Cells(5, 1) = Mid(ETUDE, POS3 + 1, Len(ETUDE) - POS3 + 1)

Je pense que tu devrais regarder la fonction split

L'équivalent de ton code avec la fonction split et on peu avoir autant de séparateur qu'on le souhaite ;)
Code:

1 2 3 4 5 6 dim tableau() as string 'c'est plus économe en terme de mémoire de donner un type au variables dim i as integer tableau=split(Cells(1, 1)," ") for i=0 to ubound (tableau) cells(1,i+1)=tableau(i) next i
Mais je pense que les piste de Leforestier et Ouskel'n'or pour résoudre le problème à l'importation seront plus efficace

10/07/2009, 15h05
zakou76

Salut à tous.
Je crois que je ne me suis pas bien exprimé, donc voici réellement ce que j'ai comme données.
J'ai une feuille aux données format CSV de largeur fixe de ce type:

01-07-2009 03:31:55 Approuvé Permettre le tri
01-07-2009 03:41:05 MAJ OK
01-07-2009 03:43:42 Approuvé Permettre le tri
*****
TEXT TEXT
01-07-2009 06:31:55 A finaliser Non valide
01-07-2009 07:31:55 MAJ Non Valide

Chaque enregistrement se trouve dans une seule cellule. Je voudrais convertir en VBA toute la colonne "A" de telle façon à avoir en:
A1==> 01-07-2009
B1==> 03:31:55
C1==> Approuvé
D1==> Permettre le tri

Et ainsi de suite pour les autres enregistrements.
Le 2eme problème est que je voudrais avoir le resultat dans une nouvelle feuille et je voudrais par la suite supprimer toutes les toutes les lignes dont la 1ere colonne n'est pas une date comme les lignes ***** et TEXT TEXT
En un mot mon tableau ressemblerais à ceci:

01-07-2009 03:31:55 Approuvé Permettre le tri
01-07-2009 03:41:05 MAJ OK
01-07-2009 03:43:42 Approuvé Permettre le tri
01-07-2009 06:31:55 A finaliser Non valide
01-07-2009 07:31:55 MAJ Non Valide

Avec des dates en colonne A, des heures en colonne B, un texte en colonne C et un autre texte en colonne D
Merci pour votre aide.
10/07/2009, 18h28
ouskel'n'or

Tu as trois problèmes :
1 - On commence par exclure les cellules dont le contenu ne dépasse pas 19 caractères puis les cellules qui ne commencent pas par une date (si cette situation est possible) [If not isdate(left(cells(NoLig, NoCol),10) then] 'dans les deux cas on efface la ligne et on se retrouve sur la ligne suivante
2 - La séparation de la date, de l'heure et du texte -> Left et Mid peuvent faire ça très bien vu que la date et l'heure sont formatées. LaDate = Left(lacellule,10) et Lheure = mid(LaCellule, 12, 8). Donc reste le texte, tout le texte
3 - Le découpage du texte selon ce qu'il est : Si c'est Approuvé, ce n'est pas A finaliser
Ici il faut connaître tous les textes possibles et connaître leurs découpages dans les cellules. Ceci connu, un [select case "LeTexteQuiReste"] devrait régler le problème. Si ça va dans la Case "Approuvé Permettre le tri" tu sais automatiquement que la colonne 3 doit contenir "Approuvé" et que donc la colonne 4 doit contenir la suite...

Reste à copier les extractions dans une autre feuille et là ce n'est pas un problème. Tu dois connaître le nom de cette autre feuille et savoir comment ajouter une ligne à un N° de ligne.
Tu crois que tu sauras faire ça ? ;)
Bon courage

Rebonjour
Merci pour les explications mais le problème est dans l'execution de ce bout de code qui me sort en erreur ceci:
"Erreur d'execution 1004"
AUCUNE DONNEE A LA LECTURE N A ETE SELECTIONNE.

Voici le code:
Code:

1 2 3 4 5 6 7 8 9 Columns("D:D").Select Selection.Copy Sheets.Add ActiveSheet.Paste Application.CutCopyMode = False Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(10, 9), Array(12, 1), Array(20, 9), Array(24, 1), _ Array(66, 1), Array(80, 9)), TrailingMinusNumbers:=True Range("A1").Select
Quant j'execute le code par macro c'est bon mais des que je le met dans mon module il me sort AUCUNE DONNEE SELECTIONNEE... pourtant j'ai bien:

Columns("D:D").Select
Selection.Copy

10/07/2009, 21h19
ouskel'n'or
Citation:
Envoyé par ouskel'n'or

Teste ça sans utiliser les arrays inutiles ici si le séparateur est bien un espace.

Code:

1 2 3 Columns("A").Select Selection.TextToColumns DataType:=xlDelimited, _ ConsecutiveDelimiter:=True, Space:=True
Mais je pratique toujours à l'envers par rapport à ce que tu fais
Code:

1 2 3 NomFeuil = ActiveSheet.Name Sheets.Add Worksheets(NomFeuil).Columns("D:D").Copy ActiveSheet.Range("A1")
L'avantage ? Jamais d'erreur ! ;)

PS - Quel séparateur de données as-tu dans ton csv ? Si ce sont des ";" remplace "Space:=True" par "Semicolon:=True"
11/07/2009, 22h16
zakou76
Bonjour à tous.
Merci pour toutes ces réponses mais mon problème est resté tel quel.
j'ai testé ce code:
Code:

1 2 3 Columns("A").Select Selection.TextToColumns DataType:=xlDelimited, _ ConsecutiveDelimiter:=True, Space:=True
ca marche mais c'est pas ce que je veux car des cellules contenant du texte sont fractionnées à chaque espace. par exemple j'ai dans une cellule "NON" et dans la cellule à droite "TEMRMINE" alors que moi je veux avoir dans la meme cellule: "NON TERMINE" et c'est pour cela que j'utilise les ARRAY. En effet avec le menu: DONNEE CONVERTIR j'ai l'option COLONNE NON DISTRIBUEE.
Merci à +
14/07/2009, 17h49
ouskel'n'or

D'où vient ton fichier texte ? qui le génère ? Es-tu sûr qu'il n'y a pas une tabulation comme séparateur ? (on ne les voit pas et on peut les prendre pour des espaces) Le mieux serait que tu nous envoie un bout de ton fichier texte (quelques lignes) en supprimant les noms le cas échéant.

Bonjour à tous,

ousk, le fichier est dans un format "largeur fixe", on n' a donc pas besoin de connaître le délimiteur.

zakou76, essaye ceci (à mettre dans un module standard)

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub SplitColumn()
  Dim wksSource As Worksheet
  Dim wksDest As Worksheet
  Set wksSource = Sheets("Feuil1") ' Adapter le nom de la feuille
  Set wksDest = Worksheets.Add
  wksSource.Columns("D:D").Copy wksDest.Cells(1, 1)
  wksDest.Columns(1).TextToColumns Destination:=wksDest.Cells(1, 1), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(10, 9), Array(12, 1), Array(20, 9), Array(24, 1), _
        Array(66, 1), Array(80, 9))
  wksDest.Cells(1, 1).Select
End Sub