Почему я не могу сохранить мой массив?

Question

У меня есть этот код в VBA, пытаясь заполнить динамический массив с данными, извлеченными из текстового файла, но появляется мне ошибку

«подстрочные вне диапазона».

Я попытался сделать это с ненулевыми массивами, но получаю ту же ошибку.

Модуль 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