将csv文件加载到VBA数组而不是Excel工作表中

问题描述 投票:16回答:5

我目前能够通过以下代码上传数据然后处理表格将csv文件数据输入到Excel VBA中,当然不是最好的方式,因为我只对一些数据感兴趣并在使用数据后删除表格:

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 

是否可以简单地将csv加载到VBA中的二维变量数组中,而不是通过使用excel工作表?

excel vba excel-vba
5个回答
14
投票

好的,看起来你需要两件事:从文件中流式传输数据,然后填充二维数组。

我有一个'Join2d'和一个'Split2d'功能(我记得刚刚在StackOverflow的另一个回复中发布它们)。请查看代码中的注释,如果您正在处理大型文件,则可能需要了解有关高效字符串处理的信息。

但是,使用它并不是一项复杂的功能:如果您赶时间,请粘贴代码。

流式传输文件很简单但是我们对文件格式做出了假设:文件中的行是由回车字符或回车和换行字符对分隔的吗?我假设'CR'而不是CRLF,但你需要检查一下。

关于格式的另一个假设是数字数据将按原样显示,字符串或字符数据将封装在引号中。这应该是真的,但通常不是......并且剥离引号会增加很多处理 - 大量的分配和释放字符串 - 你真的不想在大型数组中做。我已经明确了逐个单元格的查找和替换,但它仍然是大文件的问题。

无论如何:这是源代码:注意StackOverflow的文本框控件插入的换行符:

运行代码:

请注意,您需要对Microsoft Scripting Runtime(system32 \ scrrun32.dll)的引用

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

流式传输csv文件。

请注意,我假设您的文件位于临时文件夹中:C:\ Documents and Settings [$ USERNAME] \ Local Settings \ Temp您需要使用filesystem命令将文件复制到本地文件夹中:它总是比在网络上工作。


    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

Split2d函数,它从字符串创建一个二维VBA数组;和Join2D,反过来:


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

分享和享受。


11
投票

是的,将其作为文本文件阅读。

看这个例子

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

跟进

就像我在评论AFAIK中提到的那样,没有直接从csv填充二维数组的方法。你将不得不使用我上面给出的代码,然后每行分割它,最后填满一个可能很麻烦的2D数组。填写列很容易,但如果您特别想要从第5行到第7列数据,则会变得很麻烦,因为您必须检查数据中是否有足够的列/行。以下是在二维阵列中获取Col B的基本示例。

注意:我没有做任何错误处理。我相信你可以照顾到这一点。

假设我们的CSV文件看起来像这样。

当您运行此代码时

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

您将获得如下所示的输出

顺便说一句,我很好奇,因为你在Excel中这样做,为什么不使用内置的Workbooks.OpenQueryTables方法,然后将范围读入2D数组?那会更简单......


5
投票

好了,看了之后,我得到的解决方案是使用ADODB(需要引用ActiveX数据对象,这会将csv文件加载到数组中,而不会循环行列。是否要求数据处于良好状态。

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

0
投票

或者,您可以使用这样的代码

Dim line As String, Arr as VAriant,
Dim FSO As FileSystemObject, Fo As TextStream

While Not Fo.AtEndOfStream
 line = Fo.ReadLine      ' Read the csv file line by line
 Arr = Split(line, ",")  ' The csv line is loaded into the Arr as an array
 For i = 0 To UBound(Arr) - 1: Debug.Print Arr(i) & " ";: Next
 Debug.Print
Wend

 01/01/2019 1 1 1 36 55.6 0.8 85.3 95 95 109 102 97 6 2.5 2.5 3.9 
 01/01/2019 1 2 0 24 0.0 2.5 72.1 89 0 0 97 95 10 6.7 4.9 3.9 
 01/01/2019 1 3 1 36 26.3 4 80.6 92 92 101 97 97 8 5.5 5.3 3.7 
 01/01/2019 1 4 0 16 30.0 8 79.2 75 74 87 87 86 10 3.8 4 4.2 

0
投票

为了将典型的csv数据文件转换为2D数组,我最终采用了以下方法,该方法似乎运行良好并且非常快。我现在认为文件读取操作相当快,所以我在csv文件上运行第一次传递以获得数组的两个维度所需的大小。对于适当尺寸的数组,然后逐行重新读取文件并填充数组是一项简单的任务。

Function ImportTestData(ByRef srcFile As String, _
                        ByRef dataArr As Variant) _
                        As Boolean

Dim FSO As FileSystemObject, Fo As TextStream
Dim line As String, Arr As Variant
Dim lc As Long, cc As Long
Dim i As Long, j As Long

ImportTestData = False
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Fo = FSO.OpenTextFile(srcFile)

' First pass; read the file to get array size
lc = 0 ' Counter for number of lines in the file
cc = 0 ' Counter for number of columns in the file
While Not Fo.AtEndOfStream  ' Read the csv file line by line
    line = Fo.ReadLine
    If lc = 0 Then ' Count commas to get array's 2nd dim index
        cc = 1 + Len(line) - Len(Replace(line, ",", ""))
    End If
    lc = lc + 1
Wend
Fo.Close

' Set array dimensions to accept file contents
ReDim dataArr(0 To lc - 1, 0 To cc - 1)
'Debug.Print "CSV has "; n; " rows with "; lc; " fields/row"
If lc > 1 And cc > 1 Then
    ImportTestData = True
End If

' Second pass; Re-open data file and copy to array
Set Fo = FSO.OpenTextFile(srcFile)
lc = 0
While Not Fo.AtEndOfStream
    line = Fo.ReadLine
    Arr = Split(line, ",")
    For i = 0 To UBound(Arr)
        dataArr(lc, i) = Arr(i)
    Next i
    lc = lc + 1
Wend

End Function   'ImportTestData()

如果需要,我将其创建为Function而不是Sub来获取简单的返回值。读取包含8,500行20列的文件大约需要180ms。

© www.soinside.com 2019 - 2024. All rights reserved.