Question

我在vba中有这个代码，试图用从文本文件中提取的数据填充动态数组，但看起来是个错误

＆＃34;下标超出范围＆＃34;。

我确实尝试使用非零数组进行此操作，但我收到了同样的错误。

模块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

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

2 个答案: