Importation d'un fichier CSV en VBA

Version imprimable

25/01/2011, 16h47
Carlu

Importation d'un fichier CSV en VBA

EN VBA, est-il possible d'importer les données d'un fichier CSV avec certain critères (je le fais avec Excel normalement, mais je dois classer manuellement 1000 à 1200 lignes) et je m'explique:

Je voudrais qu'en important le fichier CSV, avec colonne délémitée et avec des virgules comme séparateurs, que les lignes avec la mention "samedi" de la colonne F (ou la 6è colonne) se retrouve dans le 1er onglet avec comme nom "samedi" et les lignes avec la mention "Dimanche" se retrouve dans le 2è onglet avec comme nom d'onglet "Dimanche"

Un immense merci
25/01/2011, 18h37
helas

Bonsoir,
avec la commande TransferText
25/01/2011, 19h10
Carlu

Oui, si cela veut dire de transférer le texte dans mon classeur Excel.

Merci

Salut,Un début de réponse ,sans aucun doute à adapter et améliorer
je n'ai pas généré de fichier de test donc à toi de poursuivre

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
' Sous VBE cocher référence Microsoft Scripting Runtime
Option Explicit
 
Sub Lecture()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv")
    If Fichier <> False Then Lire Fichier
End Sub
 
Private Sub Lire(ByVal sNomFichier As String)
Dim s As String
Dim FSO As Scripting.FileSystemObject
Dim Fichier As Scripting.TextStream
Dim iRowS As Long, iRowD As Long, iCol As Long
Dim Ar() As String
Dim i As Long
Const Separateur As String * 1 = ","
 
    Worksheets("Samedi").Cells.Clear
    Worksheets("Dimanche").Cells.Clear
 
    Application.ScreenUpdating = False
 
    Set FSO = New Scripting.FileSystemObject
    Set Fichier = FSO.GetFile(sNomFichier).OpenAsTextStream(ForReading)
 
    iRowS = 0: iRowD = 0
    Do While Not Fichier.AtEndOfStream
        iCol = 1
        s = Fichier.ReadLine
        Ar = Split(s, Separateur)
        Select Case Ar(5)
            Case "Samedi"
                iRowS = iRowS + 1
                For i = LBound(Ar) To UBound(Ar)
                    Worksheets("Samedi").Cells(iRowS, iCol) = Ar(i)
                    iCol = iCol + 1
                Next i
            Case "Dimanche"
                iRowD = iRowD + 1
                For i = LBound(Ar) To UBound(Ar)
                    Worksheets("Dimanche").Cells(iRowD, iCol) = Ar(i)
                    iCol = iCol + 1
                Next i
        End Select
    Loop
    Fichier.Close
 
    Set Fichier = Nothing
    Set FSO = Nothing
 
    Application.ScreenUpdating = True
End Sub

Bonjour, à tous,
Perso quand je dois transférer des données d'un csv, je met le fichier csv et le fichier qui recevra les données dans le même répertoire.
J'ouvre le fichier de destination, et j'envoie ma macro d'import_csv.
quand l'import est fini je referme le fichier csv et cela fonctionne tres bien.

Pour ton cas voici comment cela pourrais se présenter :
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 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 Sub import_csv() Dim wk1 As Workbook, wk2 As Workbook Dim chemin As String, fichier As String Application.ScreenUpdating = False Application.DisplayAlerts = False Set wk1 = ThisWorkbook 'Indique le répertoire du fichier csv 'ici le même répertoire que le fichier destination chemin = wk1.Path & "\" 'définit le nom du fichier à importer fichier = "TEST.csv" 'ouvre le fichier csv Workbooks.Open chemin & fichier Set wk2 = Workbooks(fichier) With wk2.Sheets(1) derlign = .Range("A1").SpecialCells(xlLastCell).Row x = 2 y = 2 'recherche dans la colonne F Samedi ou dimanche et copy 'en fonction For Each cel In .Range("F1:F" & derlign) If cel.Value = "Samedi" Then .Rows(cel.Row).Copy wk1.Sheets(1).Rows(x) x = x + 1 ElseIf cel.Value = "Dimanche" Then .Rows(cel.Row).Copy wk1.Sheets(2).Rows(y) y = y + 1 End If Next cel End With wk2.Close With wk1 .Sheets(1).Name = "Samedi" .Sheets(2).Name = "Dimanche" End With Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
Bien entendu il faut adapter le nom du fichier csv et peux-être le chemin, sauf si tu met les deux fichiers dans le même répertoire.

26/01/2011, 14h20
Carlu

Bonjour rvtoulon et kiki29,

En premier j'ai essayé la solutionde kiki29 et ca bloque à "Dim FSO As Scripting.FileSystemObject" mais je ne sais pas pourquoi car je ne connais pas cette ligne de code ensuite j'ai essayé la solution de rvtoulon et je me suis rendu compte que j'ai oublié de vous dire que le fichier est en réseau, car même si j'ai bien mis le chemin complet la place de la barre oblique "\" à "chemin = wk1.Path & "\" cela indique un chemin sur le "D . . . application.data\Microsoft\Excel", j'ai fait bien des tentatives pour modifier et arriver à lui donner le bon chemin mais j'y arrive pas, je ne suis pas aussi bon que vous.

Merci de m'aider
26/01/2011, 14h55
rvtoulon
Bonjour,
je viens de faire un essai en réseau et le code fonctionne.
je te suggère de mettre les deux fichiers , le ".xls" et le ".csv" dans le même répertoire sur le réseau.
ensuite tu ne touches pas a cette ligne :

Code:

chemin = wk1.Path & "\"

si tu enlèves le "\" le chemin ne seras pas BON: par exemple tu as un répertoire qui s'appelle DOSSIER et un fichier qui s'appelle test.xls. Le chemin
C:\DOSSIERtest.xls = Pas valide
mais
c:\DOSSIER\test.xls = valide

Par contre tu met le nom de ton fichier csv ici :
Code:

1 2 3 'définit le nom du fichier à importer 'Garde les " fichier = "LE NOM DE TON FICHIER.csv"
et tu lances la macro.
Dis nous ce qu'il se passe.
26/01/2011, 15h41
Carlu

Pourtant c'est bien cela que j'ai fais, voici le chemin tel que je l'ai mis:

chemin = wk1.Path & "\\serveur\DONNEES\Partage\métaux meuble accessoires \MMA\ACC\Centralisation MMA\Rapports ville\MÉTAUX.xls
(les 2 barres obliques au début sont inscrit comme ça quand je copie l'adresse)

et le fichier .CSV est écrit comme ça; fichier = "ville.csv"

Qu'est ce que je fais de pas correct ? J,ai le message suivant:

Erreur d'exécution 1004 (je vois très bien le chemin pour faire ouvri excel et ensuite le chemin est correct pour le fichier) et il est écrit : Fichier introuvable
26/01/2011, 15h48
kiki29

Salut,pour ton erreur FSO voir remarque en tête du code

Citation:

' Sous VBE cocher référence Microsoft Scripting Runtime
26/01/2011, 15h52
rvtoulon
Tu lances ta macro à partir du fichier Métaux.xls ?
Si oui il se trouve sur le Réseau, donc pour la ligne chemin l'instruction path renvois le chemin du fichier métaux. Regarde F1 à "Path".
Ce qui veux dire que tu laisses la ligne comme je l'ai écrite, tu ne rajoutes rien.

Code:

chemin = wk1.Path & "\"

rien de plus maintenant si tu veux contrôler le chemin met ceci :
Code:

1 2 3 chemin = wk1.Path & "\" MsgBox chemin
et tu laisses ta ligne fichier :

Code:

fichier = "ville.csv"

Excuse moi d'insister mais pour le code que je t'ai donné, il faut que Métaux.xls et ville.csv soient dans le même répertoire.
26/01/2011, 17h06
Carlu

Super, Merci rvtoulon, ça marche Nickel ou presque....

Je m'excuse je croyais que je devais mettre le chemin au complet, et mes 2 fichier étaitent déjà dans le même répertoire. . . bon ça c'est réglé.

la macro fonctionne très très bien sauf que rein n'est collé dans mes feuilles nouvellement créé. . . se pourrait-il qu'il manque le code pour coller ce qui a été copié par ".Rows(cel.Row).Copy wk1.Sheets(2).Rows(y)"

merci encore de m'aider et de ta patience
26/01/2011, 17h24
rvtoulon
vérifie l'orthographe de "samedi" et "dimanche" j'ai du mettre des majuscules. il faut que ce soit écrit de la même manière.
sinon tu peux remplacer :
Code:

1 2 3 If cel.Value = "Samedi" Then '...... ElseIf cel.Value = "Dimanche" Then
par :

Code:

If LCase(cel.Value) = LCase("Samedi") Then

et

Code:

ElseIf LCase(cel.Value) = LCase("Dimanche") Then

voir si ça change quelque chose.
Sinon à la fin de la macro tu as bien deux feuilles qui s'appellent une "Samedi" et une "Dimanche"
26/01/2011, 20h42
Carlu

rvtoulon, TU EST GÉNIAL

ça fonctionne à merveille, c'était un problème de majsucule.

Je te dis milles fois MERCI
27/01/2011, 07h56
rvtoulon

Merci,
tu me flattes mais je suis un autoditacte, j'ai commencé à faire du vba le jour ou je me suis inscrit ici et j'ai encore beaucoup à apprendre, c'est grâce a se forum si j'ai aujourd'hui un niveau correct, il y a ici des gens super compétent que je remercie :ccool:.
Bonne journée.