为什么不能存储我的阵列？答案

【问题标题】：Why cannot be stored my Array?为什么不能存储我的阵列？
【发布时间】：2016-03-17 17:52:28
【问题描述】：

我在 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

【问题讨论】：

您只能使用 Redim Preserve 更改数组的 last 维度。

标签： arrays excel vba udf

【解决方案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

【讨论】：

是真的 ASH :/ "使用 Preserve 调整大小。如果使用 Preserve，则只能调整数组的最后一个维度。对于其他每个维度，您必须指定现有数组的边界。 "根据 MSDN，。无论如何，你的回答是对的，谢谢，我将为此在 UDF 工作
@JoeJoe 您可以设想先计算数组的维度，然后立即重新调整它，而不是进行计算。如果您的应用程序不是时间关键的，虽然这很慢，但它应该可以工作并且它是一个简单快速的修复。试试我编辑的答案；）

【解决方案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

【讨论】：