Extraction de plusieurs CSV

DaMoon · 8 Juillet 2008

Bonjour les VBeurs, 🙂

J'essaye depuis quelques jours d'extraire moulte fichiers CSV dans une feuille excel.

Quand j'enregistre l'import de données j'ai ce coeur de fonction :

Code:

        With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;c:\Tests\fichier.csv" _
        , Destination:=Range("A1"))
        .Name = "fichier.csv"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 7
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
End With

Et j'aimerai bien pouvoir faire ceci sur environ, euh, 200 fichiers ? 😱
Vous remarquez que je commence à la ligne 7 de mon fichier, là où sont les données qui m'intéressent.

J'ai trouvé d'autres méthodes pour ouvrir des fichiers csv mais je ne vois pas comment commencé à une ligne X avec... Si vous en connaissez, je suis ouvert !

J'aimerai en fait faire une boucle de ce type :

Code:

Sub importCSV()

Dim i As Integer
Dim Fichier As String
Dim CHEMIN As String

CHEMIN = "C:\Test"

Fichier = Dir(CHEMIN & "*.csv")
    Do While Fichier <> ""
        ActiveCell.Formula = Fichier
        Fichier = Dir
        i = i + 1
        Rows(i).Select
    Loop
End Sub

Où je remplacerai ActiveCell.Formula = Fichier par mon import.
Mon souci est que je n'arrive pas à paramétrer
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;c:\Tests\fichier.csv" _
, Destination:=Range("A1"))
Pour remplacer le lien vers le fichier et la destination...

Quelqu'un aurait une idée ? 🙂
Merci d'avance.

Staple1600 · 8 Juillet 2008

Re : Extraction de plusieurs CSV

Bonsoir

EDITION:
Fonctionne aussi

Code:

Sub Macro5_bis()
Dim Fichier As String
Fichier = "TEXT;C:\Temp\test.csv"
With ActiveSheet.QueryTables.Add(Fichier, Range("A1"))
        .Name = "test"
        .FieldNames = True
        .PreserveFormatting = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileSemicolonDelimiter = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Test OK sous XL 2000

Code:

Sub Macro5()
Dim Fichier As String
Fichier = "TEXT;C:\Temp\test.csv"
With ActiveSheet.QueryTables.Add(Fichier, Range("A1"))
        .Name = "test"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With
End Sub

DaMoon · 8 Juillet 2008

Re : Extraction de plusieurs CSV

Merci pour ta réponse !

Par contre du coup je tombe sur un autre problème :
Comment concaténer des chaines de caractères dans une même variable ?

Par exemple là j'aurai pensé faire :
Chemin = "c:\Tests\"
Fichier = Dir(CHEMIN & "*.csv")
ExtractFichier = "TEXT;" & Chemin & Fichier

Mais ça marche pas 🙁

Staple1600 · 8 Juillet 2008

Re : Extraction de plusieurs CSV

Bonsoir

test ok

Code:

Sub Macro5_ter()
[COLOR=SeaGreen] 'import de chaque csv dans une feuille séparée
'qui prend le nom du fichier[/COLOR]
Dim Chemin$, Fichier$
Chemin = "C:\temp\": Fichier = Dir(Chemin & "*.csv")
Application.ScreenUpdating = False
    Do While Fichier <> ""
    With ActiveWorkbook.Worksheets.Add
        With .QueryTables.Add("TEXT;" _
        & Chemin & Fichier, .Range("A1"))
            .Parent.Name = _
            Replace(Fichier, ".csv", "")
            .TextFileParseType = _
            xlDelimited
            .TextFileTextQualifier = _
            xlTextQualifierDoubleQuote
            .TextFileSemicolonDelimiter = _
            True
            .Refresh BackgroundQuery:= _
            False
        End With
    End With
    Fichier = Dir
    Loop
Application.ScreenUpdating = True
End Sub

DaMoon · 8 Juillet 2008

Re : Extraction de plusieurs CSV

Hmm, je ne pense pas faire comme ça, j'ai 200+ csv dont je veux extraire quelques données.

Plutôt quelque chose dans ce genre là :

Code:

Sub Macro5_ter()
'Import de chaque CSV, recopie des données sur la seconde feuille
Dim Chemin$, Fichier$
Chemin = "C:\temp\": Fichier = Dir(Chemin & "*.csv")
Application.ScreenUpdating = False
    Do While Fichier <> ""
        With .QueryTables.Add("TEXT;" _
        & Chemin & Fichier, .Range("A1"))
            .Parent.Name = _
            Replace(Fichier, ".csv", "")
            .TextFileParseType = _
            xlDelimited
            .TextFileTextQualifier = _
            xlTextQualifierDoubleQuote
            .TextFileSemicolonDelimiter = _
            True
            .TextFileStartRow = 7
            .Refresh BackgroundQuery:= _
            False
        End With
    'Macro qui extrait les données colonne Q de chaque ligne vers ligne i feuille 2
    ' puis somme des données extraite pour chaque ligne de feuille 2
    'Clear des cellules feuille 1
    Fichier = Dir
    Loop
Application.ScreenUpdating = True
End Sub

J'ai rajouté .TextFileStartRow = 7, je sais pas si il y a un ordre dans le paramétrage ?

Merci de te pencher sur mon problème.

MichelXld · 8 Juillet 2008

Re : Extraction de plusieurs CSV

bonsoir

Tu peux tester cette procédure

Code:

Sub Test()
    Dim Fichier As String, Chemin As String
    Dim i As Long
    
    'Répertoire contenant les fichiers
    Chemin = "C:\Documents and Settings\mimi\dossier"
    Fichier = Dir(Chemin & "\*.csv")
    
    'Boucle sur les fichiers
    Do While Fichier <> ""
        
        i = Range("A65536").End(xlUp).Row + 1
        ImportText Chemin & "\" & Fichier, Cells(i, 1)
        
        Fichier = Dir
    Loop
End Sub

Sub ImportText(NomFichier As Variant, Cible As Range)
    Dim QT As QueryTable
    
    Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Cible)
    
    With QT
        .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileStartRow = 7
        .Refresh
    End With
End Sub

bonne soirée
michel

Staple1600 · 9 Juillet 2008

Re : Extraction de plusieurs CSV

Bonsoir à tous

J'arrive après la bataille mais comme cela est fait:

Décompresses les fichiers CSV dans C:\Temp

le fichier Excel sur ton bureau par exemple

et testes la macro

DaMoon · 9 Juillet 2008

Re : Extraction de plusieurs CSV

Rebonjour !

Voilà où j'en suis actuellement :
Je n'arrive pas à faire la somme des 2 cellules :/
J'ai encore un peu de travail sur la présentation et le paramétrage 🙂

Code:

Option Explicit

Sub ImportCSV()
    Dim Fichier As String, Chemin As String
    Dim NumeroTest As String, NumeroPhase As String
    Dim i As Long
    Dim Phase As Long
    Dim Test As Long
    'Répertoire contenant les fichiers
    Chemin = "C:\Documents and Settings\Administrateur\Mes documents\"
    Fichier = Dir(Chemin & "\*.csv")
    i = 1
    Phase = 0
    Test = 1
    'Boucle sur les fichiers
    Do While Fichier <> ""
        ImportText Chemin & "\" & Fichier, Cells(1, 1)
        'CreationTable Colonne Q recopié sur feuille 2
        Worksheets(2).Cells(i, 1) = "Test " & Test
        Worksheets(2).Cells(i, 2) = "Phase " & Phase
        ' A boucler en fonction du nombre de ligne du fichier CSV.
        Worksheets(2).Cells(i, 3) = Worksheets(1).Cells(1, 17)
        Worksheets(2).Cells(i, 4) = Worksheets(1).Cells(2, 17)
        ' Tentative addition manquee
'        Worksheets(2).Cells(i, 5).FormulaR1C1 = "=SUM(Worksheets(2).Cells(i, 3).Value , Worksheets(2).Cells(i, 3).Value)"
        If Phase < 4 Then
            Phase = Phase + 1
        Else
            Phase = 0
            Test = Test + 1
        End If
        'Nettoyage feuille 1.
        Worksheets(1).Range("A1", Cells(i, 30)).Clear
        Fichier = Dir
        i = i + 1
    Loop
End Sub

Sub ImportText(NomFichier As Variant, Cible As Range)
    Dim QT As QueryTable
    
    Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Range("A1"))
    
    With QT
        .AdjustColumnWidth = True
        .TextFileStartRow = 7
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileCommaDelimiter = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

J'ai passé un peu de temps sur les solutions que vous m'avez fourni, mais il y a des choses que je ne comprend pas :

Que veut dire Range("A65536").End(xlUp).Row pour Michel ?

Quid des "&" et "$" à la fin des variables pour Staple ?

Du coup si je comprend pas je préfère adapter 😀
(Et comme je débute en VBA il y a des chances que je soit loin de l'optimum)

Quelqu'un a une idée pour faire la somme ?

DaMoon · 9 Juillet 2008

Re : Extraction de plusieurs CSV

On a le droit de poster 2 fois de suite ici ? 😕
Je me lance.

J'ai trouvé pour la somme :
'Worksheets(2).Cells(i, 5).FormulaR1C1 = "=SUM(RC[-2],RC[-1])"

Mais la suite c'est que mes chiffres sont avec des points, 28.34 par exemple, et non des virgules.
Du coup j'essaye de faire ça :

Worksheets(2).Cells.Replace What:=".", Replacement:=","

Mais ça ne fait que supprimer tous les points 😱
28.34 devient 2834... 😡

DaMoon · 10 Juillet 2008

Re : Extraction de plusieurs CSV

J'ai trouvé cette ligne qui fonctionne :
Worksheets(2).Cells(i, 3).Value = Replace(Worksheets(2).Cells(i, 3).Value, Chr(34) & Chr(59) & Chr(34), "Comma")

Elle remplace bien les points par des virgules, par contre je la comprend pas 😀

Effectuez une recherche sur Excel Downloads...

Extraction de plusieurs CSV

DaMoon

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

DaMoon

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

DaMoon

XLDnaute Nouveau

MichelXld

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

DaMoon

XLDnaute Nouveau

DaMoon

XLDnaute Nouveau

DaMoon

XLDnaute Nouveau

Discussions similaires

Nous accordons de l'importance à votre vie privée