Chargement de fichier csv dans un VBA tableau plutôt que d'une Feuille Excel

Je suis actuellement en mesure d'entrer dans le fichier csv des données dans Excel VBA en téléchargeant les données via le code ci-dessous puis de la manipulation de la table, sûrement pas la meilleure façon que je ne m'intéresse qu'à une partie des données et la suppression de la fiche après l'utilisation de la data:

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 charger un fichier csv dans un de deux dimensions tableau de variant en VBA plutôt que de passer par l'utilisation d'une feuille de calcul excel?

OriginalL'auteur The_Barman | 2012-09-04

Bon, on dirait que vous avez besoin de deux choses: le flux de données à partir du fichier, et de remplir un tableau 2d.

J'ai un "Join2d" et un " Split2d fonction de traîner (je me souviens de les afficher dans une autre réponse sur StackOverflow il y a un moment). Regardez les commentaires dans le code, il y a des choses que vous pourriez avoir besoin de savoir à propos de efficace de la chaîne de manutention si vous êtes le traitement de gros fichiers.

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

Streaming le fichier est simple, MAIS nous sommes de faire des hypothèses sur le format de fichier: sont les lignes dans le fichier délimité par Retour de Chariot caractères, ou le Retour Chariot et Saut de ligne-paire de caractères? Je suis en supposant que " CR " plutôt que CRLF, mais vous devez vérifier que.

Une autre hypothèse sur le format de données numériques apparaissent comme-est, et la chaîne de caractère ou de données seront encapsulés dans des guillemets. Cette devrait être vrai, mais n'est pas souvent... Et enlever les marques de devis ajoute beaucoup de traitement - beaucoup de l'allocation et la désallocation de chaînes que vous ne voulez vraiment pas être fait dans un grand tableau. J'ai coupé court évident de la cellule par cellule de recherche-remplacement, mais c'est toujours une question de gros fichiers.

De toute façon: voici le code source: attention aux sauts de lignes insérées par StackOverflow du contrôle de zone de texte:

L'exécution du 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

De la diffusion d'un fichier csv.

Noter que je suis en supposant que votre fichier est dans le dossier temp:
C:\Documents and Settings[$nom d'utilisateur]\Local Settings\Temp
Vous aurez besoin d'utiliser le système de fichier de commandes pour copier le fichier dans un dossier local: il est toujours plus rapide que de travailler à travers 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 Split2d Fonction, ce qui crée un 2-dimensions VBA tableau à partir d'une chaîne de caractères; 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

De partager et de profiter.

Aimer votre code et à haïr votre mise en forme! Vous suggérons de vérifier SI la mise en forme des astuces pour tuer les excès de l'espacement
Ne fonctionnera pas si les champs contiennent des retours à la ligne (ou un délimiteur de champ.
Torben est correct: 'ne fonctionnera pas si les champs contiennent des retours à la ligne (ou séparateur de champ" - si vous passer mon code une chaîne de caractères contenant les caractères de délimitation d'un fichier csv, il échoue. Votre prochaine question: comment ces caractères obtenir dans un fichier csv en premier lieu? Dans le cas où le fichier csv est correctement mis en forme, avec des chaînes entourées d'apostrophes, 'forbidden' caractères peuvent être codés... de Sorte que vous avez à faire "remplacer" sur les données entrantes, une seule chaîne à la fois.
Pour ArrayFromCSVfile, ne devrait pas arrData = Join2d(strTemp, RowDelimiter, FieldDelimiter) effectivement être arrData = Split2d(strTemp, RowDelimiter, FieldDelimiter), c'est à dire Split2d au lieu de Join2d?
Merci @dashnick - fixe, et veuillez accepter mes excuses pour ne pas s'apercevoir de cette avant que j'ai posté le code.

OriginalL'auteur Nigel Heffernan

11

Oui lire 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
```
SUIVI

Comme je l'ai mentionné ci-dessous dans les commentaires, autant que je sache, il n'y a pas de moyen direct de remplissage d'un Tableau 2d à partir d'un fichier csv. Vous devrez utiliser le code que j'ai donné ci-dessus et de la diviser ensuite par ligne et, enfin, le remplissage d'un tableau 2D qui peut être lourd. Remplissage d'une colonne est facile, mais si vous voulez dire à partir de la Ligne 5 à Col 7 Données, puis il devient lourd, vous aurez pour vérifier si il y a suffisamment de colonnes/lignes de données. Voici un exemple de base pour obtenir le Col B dans un Tableau 2D.

NOTE: je n'ai pas fait toute erreur de manipulation. Je suis sûr que vous pouvez prendre soin de cela.

Disons que notre Fichier CSV regarde aime cela.

Lorsque 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 illustré ci-dessous

BTW, je suis curieux que, depuis que vous faites cela dans Excel, pourquoi ne pas utiliser intégré Workbooks.Open ou QueryTables méthode, puis lire les range dans un tableau 2D? Ce serait beaucoup plus simple...

Et cela renvoie un tableau à deux dimensions qui je peux gérer comme si c'est dans le même format que lorsqu'il s'agit d'un tableau de feuille de calcul excel?
Pas de. Cela vous donnera un Unique Dimensions de la Matrice. Où chaque ligne sera stocké dans le tableau séparément. Vous pouvez diviser chaque ligne de la matrice à l'aide "," comme un delim, qui va encore vous donner un tableau.
donc gérer chaque ligne avec une séparation par ligne? Cela peut prendre plus de temps que la méthode d'origine. Est-il possible de charger directement dans les 2 dimensions tableau?
Non pas que je suis au courant de...
Voir la prochaine réponse: il y a une assez moyen rapide de remplissage d'un tableau 2d à partir d'un flux de texte contenant des séparateurs et des séparateurs de lignes... Et un fichier csv est exactement ce que

OriginalL'auteur Siddharth Rout

OK, après recherche dans ce, la solution que j'ai arived à l'est d'utiliser ADODB (il faut faire référence à des Objets de Données ActiveX, il charge le fichier csv dans un tableau sans le vélo, les colonnes et les lignes. Exige 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

Énorme si c'est vrai. Laissez-moi essayer!

OriginalL'auteur The_Barman

Alternativement, vous pouvez utiliser un code comme celui-ci, après avoir lu chaque ligne du fichier csv dans une chaîne de caractères que vous passez à csvline. Vous avez besoin d'un tableau R() comme Chaîne de caractères à 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 être sûr que vous Redim (0) le tableau qui va contenir les valeurs de colonne avant chaque appel à la routine, ou vous aurez un débordement de la mémoire sur vos mains. Notez que ce code ne charge que d'une ligne à la fois dans la réception de la matrice.

OriginalL'auteur agcala

Vous devez vous connecter pour publier un commentaire.