为什么不能存储我的数组？

Question

我在 vba 中有这段代码，试图用从文本文件中提取的数据填充动态数组，但出现错误

"subscripts out of range".

我确实尝试使用基于非零的数组来实现这一点，但我收到了同样的错误。

模块VBA

option explicit
Sub FromFileToExcel()
Dim Delimiter As String
Dim TextFile As Integer
Dim validRow As Integer
validRow = 0
Dim x As Integer
Dim i As Integer
Dim FilePath As String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As String
FilePath = "C:\Users\Jlopez25\Desktop\bertha\INVPLANT.prn"
TextFile = FreeFile
Open FilePath For Input As TextFile
FileContent = Input(LOF(TextFile), TextFile)
Close TextFile
LineArray() = Split(FileContent, vbCrLf)
For x = LBound(LineArray) To UBound(LineArray)
If validateData(LineArray(x)) Then
ReDim Preserve DataArray(validRow, 3) 'here occours the mistake
DataArray(validRow, 1) = Left(LineArray(i), 8)
DataArray(validRow, 2) = Mid(LineArray(i), 9, 7)
DataArray(validRow, 3) = Mid(LineArray(i), 18, 2)
validRow = validRow + 1
End If
Next x

Range("a1").Resize(UBound(DataArray, 1), UBound(DataArray, 2)).Value = DataArray()

End Sub

UDF

Public Function validateData(Data As String) As Boolean
If InStr(1, Left(Data, 8), ":", vbTextCompare) = 0 And _
Len(Replace(Left(Data, 8), " ", "", , , vbTextCompare)) > 7 And _
Left(Data, 1) <> "_" Then
validateData = True
Else
validateData = False
End If
End Function

这是我想分离到 DataArray() 中的文本文件的一些行：

abc:c
page: 1

____________________________
site    Location        item
MX823JXIA1B38C08 01
MX823JXIA9B06C58 02
MX823JXIA9B12C76 03

Answer 1

ReDim Preserve DataArray(validRow, 3) 'here occours the mistake

那是因为您不能 Redim Preserve 通过更改数组的第一个维度而只能更改最后一个维度。您可能想编写自己的自定义函数来实现此特殊 Redim.

但是从您的代码中，我可以看出可以在第一个循环中计算数组的大小，然后在另一个循环中进行计算。虽然速度慢（取决于validateData函数的复杂程度），但是很容易实现。考虑一下：

Dim arSize as Integer
For x = LBound(LineArray) To UBound(LineArray)
    If validateData(LineArray(x)) Then arsize = arSize + 1
Next
ReDim DataArray(arSize, 1 to 3) 'dimension the array

'And now do the calculation loop
For x = LBound(LineArray) To UBound(LineArray)
    If validateData(LineArray(x)) Then
    DataArray(validRow, 1) = Left(LineArray(i), 8)
    DataArray(validRow, 2) = Mid(LineArray(i), 9, 7)
    DataArray(validRow, 3) = Mid(LineArray(i), 18, 2)
    validRow = validRow + 1
End If

Answer 2

如果您 DataArray 的大小与输入文件的大小相匹配，那么您真的不需要继续调整它的大小。它的一部分仍然是空的可能并不重要...

Option Explicit

Sub FromFileToExcel()
    Dim Delimiter As String

    Dim validRow As Integer
    validRow = 0
    Dim x As Integer
    Dim i As Integer
    Dim FilePath As String
    Dim LineArray() As String
    Dim DataArray() As String

    FilePath = "C:\Users\Jlopez25\Desktop\bertha\INVPLANT.prn"

    LineArray() = Split(FileContent(FilePath), vbCrLf)

    ReDim DataArray(1 To UBound(LineArray) + 1, 1 To 3)

    For x = LBound(LineArray) To UBound(LineArray)

        If validateData(LineArray(x)) Then
            validRow = validRow + 1
            DataArray(validRow, 1) = Left(LineArray(i), 8)
            DataArray(validRow, 2) = Mid(LineArray(i), 9, 7)
            DataArray(validRow, 3) = Mid(LineArray(i), 18, 2)
        End If

    Next x

    Range("a1").Resize(UBound(DataArray, 1), UBound(DataArray, 2)).Value = DataArray()

End Sub

Public Function validateData(Data As String) As Boolean
    If InStr(1, Left(Data, 8), ":", vbTextCompare) = 0 And _
        Len(Replace(Left(Data, 8), " ", "", , , vbTextCompare)) > 7 And _
        Left(Data, 1) <> "_" Then
        validateData = True
    Else
        validateData = False
    End If
End Function

Function FileContent(sPath As String) As String
    Dim TextFile As Integer
    TextFile = FreeFile
    Open FilePath For Input As TextFile
    FileContent = Input(LOF(TextFile), TextFile)
    Close TextFile
End Function

为什么不能存储我的数组？

Why cannot be stored my Array?

arrays

excel

vba

udf