为什么不能存储我的数组？
我在vba中有这样的代码，试图填充从文本文件中提取的数据的dynamic数组，但出现一个错误
“下标超出范围”。
我曾尝试使这个非零基数组，但我收到相同的错误。
模块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
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
如果您调整DataArray的大小以匹配input文件的大小，那么您并不需要继续resize。 它可能没有关系，它的一部分仍然是空的…
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