Extraction de plusieurs CSV

D

DaMoon

XLDnaute Nouveau
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 ? :eek:
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.
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
D

DaMoon

XLDnaute Nouveau
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 :(
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
D

DaMoon

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif
M

MichelXld

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
D

DaMoon

XLDnaute Nouveau
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 :D
(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 ?
 
Vote positif 0 Vote négatif
D

DaMoon

XLDnaute Nouveau
Re : Extraction de plusieurs CSV

On a le droit de poster 2 fois de suite ici ? :confused:
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 :eek:
28.34 devient 2834... :mad:
 
Vote positif 0 Vote négatif
D

DaMoon

XLDnaute Nouveau
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 :D
 
Vote positif 0 Vote négatif

Discussions similaires

gh4
  • Question
Autres importer donnees externes
Réponses
1
Affichages
205
don_pets
don_pets
L
  • Résolu(e)
Microsoft 365 Décompte via plusieurs fichiers CSV
Réponses
12
Affichages
472
WTF
WTF
Sergent_Lipton
  • Résolu(e)
Microsoft 365 [VBA] Barre de recherche dynamique - objectif : cacher les lignes hors résultat
Réponses
3
Affichages
221
Sergent_Lipton
Sergent_Lipton
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
167
GClaire
G
F
  • Question
XL 2013 Pouvez vous m'aider à ajouter la sélection de la racine à la macro d'examen d'arborescence
Réponses
10
Affichages
351
fb62840
F
F
  • Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
645
Felipe54
F
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
198
marie3107
M
A
  • Question
XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint
Réponses
0
Affichages
294
Aldonanou
A
Mathos
  • Résolu(e)
XL 2021 (Résolu) Aide vrai/faux dans plusieurs colonnes de cases à cocher
2
Réponses
27
Affichages
559
Dranreb
Dranreb
L
  • Question
Autres Copier des données d’un fichier sans l’ouvrir juste en le sélectionnant via un UserForm
Réponses
6
Affichages
455
Liner77
L

Membres actuellement en ligne

13 membres et 80 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 412
Messages
2 088 196
Membres
103 763
dernier inscrit
p.michaux