使用Excel VBA将CSV文件读入数组

Question

我无法弄清如何使用Excel VBA读取简单的CSV文件。

只要文件路径是有效的字符串，如果我想打开和读取CSV文件，这个语句应该就足够了？

 ' Open file and read contents 
    Open FilePath For Input As #1 
    FileContent = Input(LOF(1), 1) 
    Close #1

接下来，我想创建一个具有行和列的二维数组。我认为这应该可以完成任务，但实际上并没有。

' Split file content into rows 
RowsArray = Split(FileContent, vbCrLf) 
 
' Split rows into columns 
Dim i As Long 
For i = LBound(RowsArray) To UBound(RowsArray) 
    ColumnsArray = Split(RowsArray(i), ",") 
Next i 

它不会报错，但是列数组为空，

整个函数在这里：

Public Function ReadCSVFileInToArray(FilePath) 
     
    ' Define variables 
    Dim FileContent As String 
    Dim RowsArray() As String 
   
    ' Open file and read contents 
    Open FilePath For Input As #1 
    FileContent = Input(LOF(1), 1) 
    Close #1 
     
    ' Split file content into rows 
    RowsArray = Split(FileContent, vbCrLf) 
     
    ' Split rows into columns 
    Dim i As Long 
    For i = LBound(RowsArray) To UBound(RowsArray) 
        ColumnsArray = Split(RowsArray(i), ",") 
    Next i 
    ReadCSVFileInToArray = ColumnsArray 
End Function 

我怀疑RowsArray和ColumnsArray都需要重新调整大小，但在分割它们之前如何知道它们的尺寸？

这似乎应该很容易，所以我显然没有理解某些东西。我甚至在网上找不到一个清晰的解释。

- BROnstott

Answer 1

返回CSV文件的值到一个二维数组中

示例（用法）

Sub Test()

    Const FILE_PATH As String = "C:\Test\Test.csv"
    Const ROW_DELIMITER As String = vbCrLf ' vbLf
    Const COL_DELIMITER As String = "," ' ";"
    
    Dim sArr: sArr = TextFileToArray(FILE_PATH, ROW_DELIMITER)
    If IsEmpty(sArr) Then Exit Sub
    
    Dim Data(): Data = GetSplitArray(sArr, COL_DELIMITER)
    
    ' Print to the Immediate window (Ctrl+G).
    PrintData Data
    
    ' Write to the worksheet.
    'With Sheet1.Range("A1")
    '    .Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
    'End With
    
End Sub

• 您可以在这里找到PrintData过程。

将行转换为一维数组

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns each line of a text file in an element
'               of a 1D zero-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function TextFileToArray( _
    ByVal FilePath As String, _
    Optional ByVal LineSeparator As String = vbLf) _
As Variant

    Dim TextFile As Long: TextFile = FreeFile
    
    Dim sArr() As String
    
    Open FilePath For Input Access Read As TextFile
        On Error Resume Next
            sArr = Split(Input(LOF(TextFile), TextFile), LineSeparator)
        On Error GoTo 0
    Close TextFile

    Dim n As Long
    
    For n = UBound(sArr) To LBound(sArr) Step -1
        If Len(sArr(n)) > 0 Then Exit For
    Next n
    
    If n < LBound(sArr) Then Exit Function
    If n < UBound(sArr) Then ReDim Preserve sArr(0 To n)
    
    TextFileToArray = sArr

End Function

将一维数组拆分为二维数组

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the split values of each element of a 1D array
'               in a row of a 2D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetSplitArray( _
    ByVal SourceArray As Variant, _
    Optional ByVal ColumnDelimiter As String = ",") _
As Variant

    Dim rDiff As Long: rDiff = 1 - LBound(SourceArray)

    Dim rCount As Long: rCount = UBound(SourceArray) + rDiff
    Dim cCount As Long: cCount = 1
    
    Dim Data(): ReDim Data(1 To rCount, 1 To cCount)
    
    Dim rArr() As String, r As Long, c As Long, cc As Long, rString As String
    
    For r = 1 To rCount
        rString = SourceArray(r - rDiff)
        If Len(rString) > 0 Then
            rArr = Split(rString, ColumnDelimiter)
            cc = UBound(rArr) + 1
            If cc > cCount Then
                cCount = cc
                ReDim Preserve Data(1 To rCount, 1 To cCount)
            End If
            For c = 1 To cc
                Data(r, c) = rArr(c - 1)
            Next c
        End If
    Next r

    GetSplitArray = Data

End Function

- VBasic2008

Answer 2

让 Excel 来完成工作

Public Function ReadCSVFileInToArray(FilePath)
     
    Dim wb As Workbook
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(FilePath, ReadOnly:=True)
    ReadCSVFileInToArray = wb.Sheets(1).UsedRange.Value
    wb.Close
    Application.ScreenUpdating = True

End Function

将第一行分割以获得第二个维度。

Public Function ReadCSVFileInToArray(FilePath)
     
    ' Define variables
    Dim FileContent, RowsArray, ColumnsArray
    Dim ar()
   
    ' Open file and read contents
    Open FilePath For Input As #1
    FileContent = Input(LOF(1), 1)
    Close #1
     
    ' Split file content into rows
    RowsArray = Split(FileContent, vbCrLf)
    
    ' Split header row into columns
    ColumnsArray = Split(RowsArray(0), ",")
     
    ReDim ar(1 To UBound(RowsArray) + 1, 1 To UBound(ColumnsArray) + 1)
     
    ' Split rows into columns
    Dim i As Long, j As Long
    For i = LBound(RowsArray) To UBound(RowsArray)
        ColumnsArray = Split(RowsArray(i), ",")
        For j = 0 To UBound(ColumnsArray)
            ar(i + 1, j + 1) = ColumnsArray(j)
        Next
    Next i
    ReadCSVFileInToArray = ar
   
End Function

- CDP1802

---

你测试过你的函数了吗？首先我看到一个拼写错误。ColumnsArray和ColumnArray不一样，或者你是想使用两个变量？其次，你代码中的Redim由于使用了Variant类型是无法工作的：https://learn.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/invalid-redim - Storax

Answer 3

我调整了你的代码，并在代码中添加了解释（请参见注释）

Option Explicit

Public Function ReadCSVFileInToArray(FilePath)
     
    ' Define variables
    Dim FileContent As String
    Dim RowsArray() As String
    Dim ColumnsArray() As String
    Dim vDat As Variant
   
    ' Open file and read contents
    Open FilePath For Input As #1
    FileContent = Input(LOF(1), 1)
    Close #1
     
    ' Split file content into rows
    RowsArray = Split(FileContent, vbCrLf)
    
    ' Redim the 1st dimension to have space for all rows
    Dim rowNo As Long
    rowNo = UBound(RowsArray)
    ReDim ColumnsArray(0 To rowNo, 0)
     
    ' Split rows into columns
    Dim i As Long, j As Long
    For i = LBound(RowsArray) To UBound(RowsArray)
        vDat = Split(RowsArray(i), ";")
        
        ' This will skip lines with no data especially last one if it only contains a CRLF
        If UBound(vDat) > 0 Then
            
            ' Redim the 2nd dimension to have space for all columns
            Dim colNo As Long
            colNo = UBound(vDat)
            ' Redim will preserve and fortunately we only have to change the last dimension
            ' If you use the Preserve keyword, you can resize only the last array dimension
            ' and you can't change the number of dimensions at all.
            ReDim Preserve ColumnsArray(rowNo, colNo)

            ' you have to copy element by element
            For j = 0 To colNo
                ColumnsArray(i, j) = vDat(j)
            Next j
            
        End If
    Next i
    
    ReadCSVFileInToArray = ColumnsArray
End Function

你可以用以下代码进行测试

Sub testIt()
Dim vDat As Variant

    vDat = ReadCSVFileInToArray("filepath")
    Dim rg As Range
    Set rg = Range("A1")
    ' Resize the range to the size of the array
    Set rg = rg.Resize(UBound(vDat, 1), UBound(vDat, 2))
    rg = vDat
End Sub

将文本文件导入到Excel的更好方法是使用Powerquery，因为您可以更好地控制数据类型等方面。

- Storax