Importation de données depuis un fichier .csv

Bonjour,

Voilà un exemple pour illustrer ma question.

J'ai un fichier donnees.csv qui se présente ainsi :

Nom§Prenom§Age§Date_Naissance§Ville
DUPONT§§30§04/05/1987§Paris
DURAND§Patrick§45§10/12/1974§Lille
MARTIN§Paul§§24/05/1999§Nantes

Le caractère § est le séparateur de colonne. Pour certaines lignes, il n'y a pas de données pour certaines colonnes -> §§

Je souhaite importer les données de ces 5 colonnes dans un fichier Excel, par macro VBA lancée depuis ce fichier Excel.

Est-ce possible de le faire sans ouvrir le fichier .csv ? Si oui quel est le code VBA ?

S'il faut l'ouvrir, est-ce possible d'importer les colonnes dans un fichier Excel sans passer par le traitement Excel (ou Power Query) de séparateur de colonne ?

En attente de vos solutions,

Dadams51

Bonjour,

version "classique" en ouvrant le fichier (un fichier aurait été utile pour connaître l'encodage de celui-ci)

Sub Importer()
Dim donnees As Variant
    donnees = Application.GetOpenFilename("Text Files (*.csv), *.csv")
    If donnees = False Then Exit Sub
    Extraction donnees, "§"
End Sub

Sub Extraction(Fichier As Variant, Separateur As Variant)
    Dim Tableau() As String
    Dim f As Worksheet
    Dim Resultat
    Open Fichier For Input As #1
        ligne = 1
        Do While Not EOF(1)
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne & Separateur, Separateur)
            Cells(ligne, 1).Resize(1, UBound(Tableau)) = Tableau
            ligne = ligne + 1
        Loop
    Close #1
End Sub

Si tu ne veux pas ouvrir le fichier, tu peux faire ceci (mais je n'en vois pas l'intérêt si tu ne sélectionnes pas les lignes)

Sub Importer()
Dim donnees As Variant
    donnees = Application.GetOpenFilename("Text Files (*.csv), *.csv")
    If donnees = False Then Exit Sub
    Extraction donnees, "§"
End Sub

Sub Extraction(f As Variant, Separateur As Variant)
    ' Microsoft ActiveX DataObject doit être coché

    Dim cn As Connection
    Dim rs As Recordset
    Set cn = CreateObject("ADODB.Connection")
    Set rs = New ADODB.Recordset

    repertoire = Mid(f, 1, Len(f) - Len(Dir(f)))
    Fichier = Dir(f)
    Cells.Clear

    strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & repertoire & ";" & "Extended Properties=""text;HDR=No;FMT=Delimited"";"
    cn.Open strcon

    strsql = "SELECT * FROM " & Fichier & " "
    rs.Open strsql, cn

    Cells(1, 1).CopyFromRecordset rs
    tbl = Cells(1, 1).CurrentRegion.Value
    For i = 1 To UBound(tbl)
        tableau = Split(tbl(i, 1) & Separateur, Separateur)
        Cells(i, 1).Resize(1, UBound(tableau)) = tableau
    Next

    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
End Sub

Bonjour Steelson,

Merci pour ces solutions. La1ère correspond bien à ce que je recherche !

Pour compléter mon besoin, dans l'exemple du fichier .csv que tu as joint, je souhaiterais importer uniquement les 3 premières colonnes dans Excel (sur les 5 du fichier source).
Comment adapter le code ?

Salutations,

Dadams51

Juste un changement ici :

            Tableau = Split(ContenuLigne & Separateur, Separateur)
            For j = 1 To 3
                Cells(ligne, j) = Tableau(j - 1)
            Next

code complet

Sub Importer()
Dim donnees As Variant
    donnees = Application.GetOpenFilename("Text Files (*.csv), *.csv")
    If donnees = False Then Exit Sub
    Extraction donnees, "§"
End Sub

Sub Extraction(Fichier As Variant, Separateur As Variant)
    Dim Tableau() As String
    Dim f As Worksheet
    Dim Resultat
    Open Fichier For Input As #1
        ligne = 1
        Do While Not EOF(1)
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne & Separateur, Separateur)
            For j = 1 To 3
                Cells(ligne, j) = Tableau(j - 1)
            Next
            ligne = ligne + 1
        Loop
    Close #1
End Sub

Bonjour Steelson,

Merci, sujet en VBA résolu !

Je cherche maintenant l'équivalent en Power Query (s'il est possible) car temps d'éxécution long en VBA.

Dadams51

Ah, ben fallait le dire, on peut accélérer ...

Version super speed

Sub Importer()
Dim donnees As Variant
    donnees = Application.GetOpenFilename("Text Files (*.csv), *.csv")
    If donnees = False Then Exit Sub
    Extraction donnees, "§" '"§"
End Sub

Sub Extraction(Fichier As Variant, Separateur As Variant)
    Dim Tableau() As String, result
    Dim f As Worksheet
    Dim Resultat
    Open Fichier For Input As #1
        ligne = 1
        ReDim result(1 To 4, 1 To ligne)
        Do While Not EOF(1)
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne & Separateur, Separateur)
            For j = 1 To 4
                result(j, ligne) = Tableau(j - 1)
            Next
            ligne = ligne + 1
            ReDim Preserve result(1 To 4, 1 To ligne)
        Loop
    Close #1
    Sheets("Calcul").Cells(1, 1).Resize(UBound(result, 2), UBound(result)) = Application.Transpose(result)
End Sub