Charger le fichier csv dans un tableau VBA plutôt que dans une feuille Excel

Question

Je suis actuellement en mesure de saisir des données de fichier csv dans Excel VBA en téléchargeant les données via le code ci-dessous, puis en manipulant le tableau. Ce n’est sûrement pas la meilleure solution car je ne suis intéressé que par certaines données et je supprime la feuille après l’utilisation des données:

Sub CSV_Import() 
Dim ws As Worksheet, strFile As String 

Set ws = ActiveSheet 'set to current worksheet name 

strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", ,"Please select text file...") 

With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1")) 
     .TextFileParseType = xlDelimited 
     .TextFileCommaDelimiter = True 
     .Refresh 
End With 
End Sub 

Est-il possible de simplement charger le fichier csv dans un tableau variant à deux dimensions dans VBA plutôt que d'utiliser une feuille de calcul Excel?

Answer 1

OK, après avoir examiné cette question, la solution à laquelle je suis arrivé consiste à utiliser ADODB (nécessite une référence à ActiveX Data Objects, cela charge le fichier csv dans un tableau sans alterner les colonnes des lignes. Nécessite que les données soient en bon état. 

Sub LoadCSVtoArray()

strPath = ThisWorkbook.Path & "\"

Set cn = CreateObject("ADODB.Connection")
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
cn.Open strcon
strSQL = "SELECT * FROM SAMPLE.csv;"

Dim rs As Recordset
Dim rsARR() As Variant

Set rs = cn.Execute(strSQL)
rsARR = WorksheetFunction.Transpose(rs.GetRows)
rs.Close
Set cn = Nothing

[a1].Resize(UBound(rsARR), UBound(Application.Transpose(rsARR))) = rsARR

End Sub

Answer 2

D'accord, il semblerait que vous ayez besoin de deux choses: diffuser les données à partir du fichier et remplir un tableau à deux dimensions.

J'ai une fonction 'Join2d' et une fonction 'Split2d' qui traînent (je me souviens de les avoir publiées dans une autre réponse sur StackOverflow il y a quelque temps). Examinez les commentaires dans le code, il y a des choses que vous devez savoir sur la gestion efficace des chaînes si vous manipulez des fichiers volumineux.

Cependant, ce n’est pas une fonction compliquée à utiliser: il suffit de coller le code si vous êtes pressé.

La lecture en continu du fichier est simple MAIS nous faisons des hypothèses sur le format du fichier: les lignes du fichier sont-elles délimitées par des caractères Carriage-Retour ou par la paire de caractères Carriage-Return-and-Line-Feed? Je suppose que «CR» plutôt que CRLF, mais vous devez vérifier cela.

Une autre hypothèse concernant le format est que les données numériques apparaîtront telles quelles et que les données de chaîne ou de caractère seront encapsulées entre guillemets. Ceci devrait être vrai, mais ce n'est souvent pas le cas ... Et supprimer les guillemets ajoute beaucoup de traitement - beaucoup d'allocation et de désallocation de chaînes - ce que vous ne voulez vraiment pas faire dans un grand tableau . J'ai raccourci les possibilités évidentes de recherche et de remplacement cellule par cellule, mais cela reste un problème pour les fichiers volumineux.

Quoi qu'il en soit: voici le code source: surveillez les sauts de ligne insérés par le contrôle de zone de texte de StackOverflow:

Lancer le code:  

Notez que vous aurez besoin d'une référence à Microsoft Scripting Runtime (system32\scrrun32.dll). 

Private Sub test()
    Dim arrX As Variant
    arrX = ArrayFromCSVfile("MyFile.csv")
End Sub

Streaming un fichier csv.

Notez que je suppose que votre fichier est dans le dossier temporaire: C:\Documents and Settings [$ USERNAME]\Local Settings\Temp Vous aurez besoin d’utiliser des commandes de système de fichiers pour copier le fichier dans un dossier local: c’est toujours plus rapide que de travailler sur le réseau.

    Public Function ArrayFromCSVfile( _
        strName As String, _ 
        Optional RowDelimiter As String = vbCr, _ 
        Optional FieldDelimiter = ",", _ 
        Optional RemoveQuotes As Boolean = True _ 
    ) As Variant

        ' Load a file created by FileToArray into a 2-dimensional array
        ' The file name is specified by strName, and it is exected to exist
        ' in the user's temporary folder. This is a deliberate restriction: 
        ' it's always faster to copy remote files to a local drive than to 
        ' edit them across the network

        ' RemoveQuotes=TRUE strips out the double-quote marks (Char 34) that
        ' encapsulate strings in most csv files.

        On Error Resume Next

        Dim objFSO As Scripting.FileSystemObject
        Dim arrData As Variant
        Dim strFile As String
        Dim strTemp As String

        Set objFSO = New Scripting.FileSystemObject
        strTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPath
        strFile = objFSO.BuildPath(strTemp, strName)
        If Not objFSO.FileExists(strFile) Then  ' raise an error?
            Exit Function
        End If

        Application.StatusBar = "Reading the file... (" & strName & ")"

        If Not RemoveQuotes Then
            arrData = Join2d(objFSO.OpenTextFile(strFile, ForReading).ReadAll, RowDelimiter, FieldDelimiter)
            Application.StatusBar = "Reading the file... Done"
        Else
            ' we have to do some allocation here...

            strTemp = objFSO.OpenTextFile(strFile, ForReading).ReadAll
            Application.StatusBar = "Reading the file... Done"

            Application.StatusBar = "Parsing the file..."

            strTemp = Replace$(strTemp, Chr(34) & RowDelimiter, RowDelimiter)
            strTemp = Replace$(strTemp, RowDelimiter & Chr(34), RowDelimiter)
            strTemp = Replace$(strTemp, Chr(34) & FieldDelimiter, FieldDelimiter)
            strTemp = Replace$(strTemp, FieldDelimiter & Chr(34), FieldDelimiter)

            If Right$(strTemp, Len(strTemp)) = Chr(34) Then
                strTemp = Left$(strTemp, Len(strTemp) - 1)
            End If

            If Left$(strTemp, 1) = Chr(34) Then
                strTemp = Right$(strTemp, Len(strTemp) - 1)
            End If

            Application.StatusBar = "Parsing the file... Done"
            arrData = Split2d(strTemp, RowDelimiter, FieldDelimiter)
            strTemp = ""
        End If

        Application.StatusBar = False

        Set objFSO = Nothing
        ArrayFromCSVfile = arrData
        Erase arrData
    End Function

La fonction Split2d, qui crée un tableau VBA à 2 dimensions à partir d'une chaîne; et Join2D, qui fait l'inverse:

Public Function Split2d(ByRef strInput As String, _ 
                        Optional RowDelimiter As String = vbCr, _ 
                        Optional FieldDelimiter = vbTab, _ 
                        Optional CoerceLowerBound As Long = 0 _ 
                        ) As Variant

' Split up a string into a 2-dimensional array. 

' Works like VBA.Strings.Split, for a 2-dimensional array.
' Check your lower bounds on return: never assume that any array in
' VBA is zero-based, even if you've set Option Base 0
' If in doubt, coerce the lower bounds to 0 or 1 by setting 
' CoerceLowerBound
' Note that the default delimiters are those inserted into the
'  string returned by ADODB.Recordset.GetString

On Error Resume Next

' Coding note: we're not doing any string-handling in VBA.Strings -
' allocating, deallocating and (especially!) concatenating are SLOW.
' We're using the VBA Join & Split functions ONLY. The VBA Join,
' Split, & Replace functions are linked directly to fast (by VBA
' standards) functions in the native Windows code. Feel free to 
' optimise further by declaring and using the Kernel string functions
' if you want to.

' ** THIS CODE IS IN THE PUBLIC DOMAIN **
'    Nigel Heffernan   Excellerando.Blogspot.com

Dim i   As Long
Dim j   As Long

Dim i_n As Long
Dim j_n As Long

Dim i_lBound As Long
Dim i_uBound As Long
Dim j_lBound As Long
Dim j_uBound As Long

Dim arrTemp1 As Variant
Dim arrTemp2 As Variant

arrTemp1 = Split(strInput, RowDelimiter)

i_lBound = LBound(arrTemp1)
i_uBound = UBound(arrTemp1)

If VBA.LenB(arrTemp1(i_uBound)) <= 0 Then  
    ' clip out empty last row: a common artifact in data 
     'loaded from files with a terminating row delimiter
    i_uBound = i_uBound - 1
End If

i = i_lBound
arrTemp2 = Split(arrTemp1(i), FieldDelimiter)

j_lBound = LBound(arrTemp2)
j_uBound = UBound(arrTemp2)

If VBA.LenB(arrTemp2(j_uBound)) <= 0 Then 
 ' ! potential error: first row with an empty last field...
    j_uBound = j_uBound - 1
End If

i_n = CoerceLowerBound - i_lBound
j_n = CoerceLowerBound - j_lBound

ReDim arrData(i_lBound + i_n To i_uBound + i_n, j_lBound + j_n To j_uBound + j_n)

' As we've got the first row already... populate it
' here, and start the main loop from lbound+1

For j = j_lBound To j_uBound
    arrData(i_lBound + i_n, j + j_n) = arrTemp2(j)
Next j

For i = i_lBound + 1 To i_uBound Step 1

    arrTemp2 = Split(arrTemp1(i), FieldDelimiter)

    For j = j_lBound To j_uBound Step 1
        arrData(i + i_n, j + j_n) = arrTemp2(j)
    Next j

    Erase arrTemp2

Next i

Erase arrTemp1

Application.StatusBar = False

Split2d = arrData

End Function


Public Function Join2d(ByRef InputArray As Variant, _ 
                       Optional RowDelimiter As String = vbCr, _ 
                       Optional FieldDelimiter = vbTab,_ 
                       Optional SkipBlankRows As Boolean = False _ 
                       ) As String

' Join up a 2-dimensional array into a string. Works like the standard
'  VBA.Strings.Join, for a 2-dimensional array.
' Note that the default delimiters are those inserted into the string
'  returned by ADODB.Recordset.GetString

On Error Resume Next

' Coding note: we're not doing any string-handling in VBA.Strings - 
' allocating, deallocating and (especially!) concatenating are SLOW.
' We're using the VBA Join & Split functions ONLY. The VBA Join,
' Split, & Replace functions are linked directly to fast (by VBA
' standards) functions in the native Windows code. Feel free to 
' optimise further by declaring and using the Kernel string functions
' if you want to.

' ** THIS CODE IS IN THE PUBLIC DOMAIN **
'   Nigel Heffernan   Excellerando.Blogspot.com

Dim i As Long
Dim j As Long

Dim i_lBound As Long
Dim i_uBound As Long
Dim j_lBound As Long
Dim j_uBound As Long

Dim arrTemp1() As String
Dim arrTemp2() As String

Dim strBlankRow As String

i_lBound = LBound(InputArray, 1)
i_uBound = UBound(InputArray, 1)

j_lBound = LBound(InputArray, 2)
j_uBound = UBound(InputArray, 2)

ReDim arrTemp1(i_lBound To i_uBound)
ReDim arrTemp2(j_lBound To j_uBound)

For i = i_lBound To i_uBound

    For j = j_lBound To j_uBound
        arrTemp2(j) = InputArray(i, j)
    Next j

    arrTemp1(i) = Join(arrTemp2, FieldDelimiter)

Next i

If SkipBlankRows Then

    If Len(FieldDelimiter) = 1 Then
        strBlankRow = String(j_uBound - j_lBound, FieldDelimiter)
    Else
        For j = j_lBound To j_uBound
            strBlankRow = strBlankRow & FieldDelimiter
        Next j
    End If

    Join2d = Replace(Join(arrTemp1, RowDelimiter), strBlankRow, RowDelimiter, "")
    i = Len(strBlankRow & RowDelimiter)

    If Left(Join2d, i) = strBlankRow & RowDelimiter Then
        Mid$(Join2d, 1, i) = ""
    End If

Else

    Join2d = Join(arrTemp1, RowDelimiter)    

End If

Erase arrTemp1

End Function

Partager et profiter.

Answer 3

Oui, lisez-le comme un fichier texte.

Voir cet exemple

Option Explicit

Sub Sample()
    Dim MyData As String, strData() As String

    Open "C:\MyFile.CSV" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
End Sub

SUIVRE

Comme je l'ai mentionné ci-dessous dans les commentaires, autant que je sache, il n'y a pas de moyen direct de remplir un tableau 2D à partir d'un fichier CSV. Vous devrez utiliser le code que j'ai donné ci-dessus, puis le scinder par ligne et enfin remplir un tableau 2D qui peut s'avérer fastidieux. Remplir une colonne est facile, mais si vous voulez spécifiquement définir les données de la rangée 5 à la colonne 7, cela devient fastidieux, car vous devrez vérifier si le nombre de colonnes/lignes est suffisant. Voici un exemple de base pour obtenir Col B dans un tableau 2D.

NOTE: Je n'ai pas traité d'erreur. Je suis sûr que vous pouvez vous en occuper.

Disons que notre fichier CSV ressemble à ceci.

Quand vous exécutez ce code

Option Explicit

Const Delim As String = ","

Sub Sample()
    Dim MyData As String, strData() As String, TmpAr() As String
    Dim TwoDArray() As String
    Dim i As Long, n As Long

    Open "C:\Users\Siddharth Rout\Desktop\Sample.CSV" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)

    n = 0

    For i = LBound(strData) To UBound(strData)
        If Len(Trim(strData(i))) <> 0 Then
            TmpAr = Split(strData(i), Delim)
            n = n + 1
            ReDim Preserve TwoDArray(1, 1 To n)
            '~~> TmpAr(1) : 1 for Col B, 0 would be A
            TwoDArray(1, n) = TmpAr(1)
        End If
    Next i

    For i = 1 To n
        Debug.Print TwoDArray(1, i)
    Next i
End Sub

Vous obtiendrez la sortie comme indiqué ci-dessous

BTW, je suis curieux de savoir que puisque vous faites cela dans Excel, pourquoi ne pas utiliser la méthode Workbooks.Open ou QueryTables incorporée puis lire la plage dans un tableau 2D? Ce serait beaucoup plus simple ...

Answer 4

Sinon, vous pouvez utiliser un code comme celui-ci, après avoir lu chaque ligne du fichier csv dans une chaîne que vous transmettez à csvline . Vous avez besoin d'un tableau R() as String pour recevoir les valeurs des colonnes. Ce tableau doit être redim-ed (0) avant chaque appel à CSVtoArray

Public Sub CSVtoArray(A() As String, csvline As String)
'***************************************************************************
'* WARNING:  Array A() needs to be Redim-ed (0) each time BEFORE routine is*
'* called!!                                                                *
'***************************************************************************
Dim k As Integer, j As Integer
k = InStr(csvline, ",") ' Or whatever delimiter you use
j = UBound(A)
j = j + 1
ReDim Preserve A(j)
If k = 0 Then
 A(j) = Trim(csvline)
 Exit Sub
End If
A(j) = Trim(Mid(csvline, 1, k - 1))
CSVtoArray A(), Mid(csvline, k + 1)
End Sub

Dans ce cas, vous devez vous assurer que vous avez Redim (0) le tableau qui contiendra les valeurs de colonne avant chaque appel à la routine, sinon vous aurez un dépassement de mémoire. Notez que ce code ne charge qu'une ligne à la fois dans le tableau de réception.