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?
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
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.
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 ...
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.