Question

我目前能够通过以下代码上传数据然后处理表格，将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工作表？

Answer 1

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

我有一个＆＃39; Join2d＆＃39;和一个＆lt; Split2d＆＃39;功能四处闲逛（我记得刚刚在StackOverflow的另一个回复中发布它们）。请查看代码中的注释，如果您正在处理大型文件，则可能需要了解有关高效字符串处理的事项。

然而，使用它并不是一项复杂的功能：如果您匆忙，请粘贴代码。

流式传输文件很简单但我们正在对文件格式做出假设：文件中的行是由回车字符或回车和换行字符对分隔的吗？我假设＆＃39; CR＆＃39;而不是CRLF，但你需要检查它。

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

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

运行代码：

请注意，您需要引用Microsoft Scripting Runtime（system32 \ scrrun32.dll）

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

流式传输csv文件。

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


    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

分享并享受。

Answer 2

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

参见此示例

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放入2D数组的基本示例。

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

让我们说我们的CSV文件看起来像这样。

enter image description here

运行此代码时

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

您将获得如下所示的输出

enter image description here

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

Answer 3

好了，看了之后，我得到的解决方案是使用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

Answer 4

或者你可以使用像这样的代码

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

Answer 5

为了将典型的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()

如果需要，我将其创建为函数而不是Sub以获得简单的返回值。读取包含8500行20列的文件大约需要180毫秒。

Answer 6

以下解决方案不使用ActiveX：

我编写了将csv（实际上是制表符分隔的）文件导入数组的代码。该代码如下。

首先让我们指定数组（最初它是完全无效的，但是稍后会适当调整其大小）：

Dim TxtFile$()

现在用于子过程：

' Fills TxtFile$() array
Sub FillTextFileArray(A$)

'***********************************************************************
' Declarations
'***********************************************************************
Dim I, J As Integer
Dim LineString As String
'***********************************************************************

I = -1: J = 0    ' Will hold array dimentions

Open A$ For Input As #1

Do While Not EOF(1)    ' Loop until end of file.
    Line Input #1, LineString
    LineString = LineString + vbTab    ' If not done empty lines give error with Split()
    I = I + 1
    If J < UBound(Split(LineString, vbTab)) Then J = UBound(Split(LineString, vbTab))
Loop

ReDim TxtFile$(1 To I + 4, 1 To J + 4)    ' Not indexed from 0 ! (Plus some room at the end.) This is done to match worksheet format.
Seek #1, 1    ' Reset to start

I = -1    ' Will hold array row index
Do While Not EOF(1)    ' Loop until end of file.
    Line Input #1, LineString
    LineString = LineString + vbTab    ' If not done empty lines give error with Split()
    I = I + 1
    For J = 0 To UBound(Split(LineString, vbTab))
        TxtFile$(I + 1, J + 1) = Split(LineString, vbTab)(J)
    Next J
Loop

Close #1    ' Close file.

' TxtFile$() now holds the contents of the text file

End Sub

显然，您可以使用TxtFile $数组执行所需的操作。 A $是文本文件的位置和名称。如前所述，此特定代码适用于制表符分隔的文件（vbTab），而不适用于以逗号分隔（分隔）的文件，但是任何改编都不应该太困难。它具有避免ActiveX并发症的优点。

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

6 个答案:

以下解决方案不使用ActiveX：