windows 使用Excel VBA将csv文件读入数组

lf5gs5x2  于 2023-05-08  发布在  Windows
关注(0)|答案(4)|浏览(223)

我无法弄清楚如何使用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

它不会给予错误,但columns数组为空,
整个函数在这里:

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都需要重定维度,但是在拆分它们之前如何知道维度呢?
看起来这应该很简单,所以我显然不明白什么。我甚至在网上找不到一个合理的解释。

axzmvihb

axzmvihb1#

让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 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 header row into columns
    ColumnsArray = Split(RowsArray(0), ",")
     
    ReDim ReadCSVFileInToArray(1 To UBound(RowsArray) + 1, 1 To UBound(ColumnArray, 2))
     
    ' 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(RowsArray)
            ReadCSVFileInToArray(i + 1, j + 1) = ColumnsArray(j)
        Next
    Next i
   
End Function
brjng4g3

brjng4g32#

CSV界面是您解决问题所需的工具。请检查documentation

pgky5nke

pgky5nke3#

以二维数组形式返回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过程here
    行到一维数组
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
xoefb8l8

xoefb8l84#

我调整了您的代码,并在代码中添加了解释(参见注解)

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

import text files导入Excel的更好方法是Powerquery,因为您可以对数据类型等进行更多控制。

相关问题