在VBS中将一个Array的部分数据存储到另一个Array中

Question

我有一个以下格式的 CSV 文件：

abc, def
ghi, xyz

我使用此函数将文件内的数据放入数组中：

Public Function readeEachColumnDataExcel()
    Dim filename
    Dim fso
    Dim f
    Dim arrData
    Dim arrDataParameter()
    Dim fData
    
    filename = "test.csv"
    
    Set fso = createobject("scripting.filesystemobject")
    Set f  = fso.OpenTextFile("C:\Users\U5UI5TU\Documents\PDRM_Project\Excel\"& Filename)
    
    While not f.AtEndOfStream
        fData = f.ReadLine    ' Read CSV File Line
        arrData = split(fData,",")    'Split the line
        'arrDataParameter = arrData(1)
    Wend

    f.Close
    Set fso=Nothing
End Function
 
Call readeEachColumnDataExcel

现在我想将每次迭代的

arrData

的第二个值保存到数组

arrDataParameter

中（请参阅注释行）。我怎样才能做到这一点？对此的任何帮助将不胜感激。

Answer 1

CSV 列到数组

测试.csv

• 空行仅用于说明代码的行为。

abc,def

ghi,jkl
mno,pqr

结果

代码

• 通常，列分隔符没有空格。如果是，请将

  ","

  替换为

  ", "

  。
• 如果文件为空，即长度为 0，该函数将返回一个 empty Variant (

  Empty

  )。

Option Explicit

' Main

Const FOLDER_PATH = "C:\Users\U5UI5TU\Documents\PDRM_Project\Excel\"
Const FILE_NAME = "test.csv"
Const COLUMN_INDEX = 1 ' zero-based
Const COLUMN_SEPARATOR = ","

Dim Arr: Arr = CsvColumnToArray( _
    FOLDER_PATH, FILE_NAME, COLUMN_INDEX, COLUMN_SEPARATOR)

If Not IsEmpty(Arr) Then
    MsgBox "Result" & vbLf & vbLf & "Strings Found: ... " & UBound(Arr) + 1 _
        & vbLf & Join(Arr, vbLf), vbInformation, "Test"
End If

' Procedures

Private Function CsvColumnToArray( _
        FolderPath, _
        Filename, _
        ColumnIndex, _
        ColumnSeparator)
    Const PROC_TITLE = "CSV Column To Array"
    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

    If Not fso.FolderExists(FolderPath) Then
        MsgBox "The path """ & FolderPath & """ doesn't exist!", _
            vbCritical, PROC_TITLE
        Exit Function
    End If
    
    Dim FilePath: FilePath = FolderPath & Filename

    If Not fso.FileExists(FilePath) Then
        MsgBox "The file """ & FILE_NAME & """ doesn't exist in """ _
            & FolderPath & """!", vbCritical, PROC_TITLE
        Exit Function
    End If

    Dim n: n = 0
    Dim WasLineFound: WasLineFound = False

    Dim fsoFile: Set fsoFile = fso.OpenTextFile(FilePath)

    Dim ArrSplit, ArrResult(), CurrentLine, CurrentString, HadStringLength

    Do While Not fsoFile.AtEndOfStream
        CurrentLine = fsoFile.ReadLine
        HadStringLength = False
        If Len(CurrentLine) > 0 Then
            ArrSplit = Split(CurrentLine, ColumnSeparator)
            If UBound(ArrSplit) >= ColumnIndex Then
                CurrentString = ArrSplit(ColumnIndex)
                If Len(CurrentString) > 0 Then
                    ReDim Preserve ArrResult(n): ArrResult(n) = CurrentString
                    HadStringLength = True
                End If
            End If
        End If
        If Not WasLineFound Then
            If n > 0 Or Len(CurrentLine) > 0 Then WasLineFound = True
        End If
        n = n + 1
    Loop

    fsoFile.Close

    If Not WasLineFound Then
        MsgBox "No data found in """ & FilePath & """!", _
        vbCritical, PROC_TITLE
        Exit Function
    End If

    If Not HadStringLength Then ReDim Preserve ArrResult(n - 1)
    
    CsvColumnToArray = ArrResult

End Function