excel - 使用findnext填充多维数组VBA Excel

Question

我的问题实际上涉及到 EXCEL VBA Store search results in an array? 的问题。

此处 Andreas 尝试搜索列并将命中结果保存到数组中。我也在尝试同样的事情。但不同之处在于(1)查找值(2)我想从(3)与找到搜索值的同一行中的单元格复制不同的值类型，(4)复制到二维数组。

所以数组(概念上)看起来像:

Searchresult.1st SameRow.Cell1.Value1 SameRow.Cell2.Value2 SameRow.Cell3.Value3
Searchresult.2nd SameRow.Cell1.Value1 SameRow.Cell2.Value2 SameRow.Cell3.Value3
Searchresult.3rd SameRow.Cell1.Value1 SameRow.Cell2.Value2 SameRow.Cell3.Value3

Etc.

我使用的代码如下所示:

Sub fillArray()

Dim i As Integer
Dim aCell, bCell As Range
Dim arr As Variant

i = 0 

Set aCell = Sheets("Log").UsedRange.Find(What:=("string"), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False)

If Not aCell Is Nothing Then
    Set bCell = aCell
    ReDim Preserve arr(i, 5)
    arr(i, 0) = True 'Boolean
    arr(i, 1) = aCell.Value 'String
    arr(i, 2) = aCell.Cells.Offset(0, 1).Value 
    arr(i, 3) = aCell.Cells.Offset(0, 3).Value
    arr(i, 4) = aCell.Cells.Offset(0, 4).Value
    arr(i, 5) = Year(aCell.Cells.Offset(0, 3).Value)

    i = i + 1

    Do While exitLoop = False
            Set aCell = Sheets("Log").UsedRange.FindNext(after:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                'ReDim Preserve arrSwUb(i, 5)
                    arr(i, 0) = True
                    arr(i, 1) = aCell.Value
                    arr(i, 2) = aCell.Cells.Offset(0, 1).Value
                    arr(i, 3) = aCell.Cells.Offset(0, 3).Value
                    arr(i, 4) = aCell.Cells.Offset(0, 4).Value
                    arr(i, 5) = Year(aCell.Cells.Offset(0, 3).Value)

                    i = i + 1
            Else
                exitLoop = True
            End If
    Loop


End If

End Sub

在循环中重新调整数组时似乎出错了。我收到下标超出范围错误。我想我无法像现在一样重新调整数组，但我不知道应该如何完成它。

如果有任何关于我做错了什么的线索，我将不胜感激。

Answer 1

ReDim Preserve 只能调整数组最后一个维度的大小: http://msdn.microsoft.com/en-us/library/w8k3cys2(v=vs.71).aspx

来自上面的链接:

保留

可选。当您仅更改最后一个维度的大小时，用于保留现有数组中的数据的关键字。

编辑: 这并没有多大帮助，是吗？我建议你转置你的数组。此外，来自数组函数的那些错误消息也很糟糕。

根据 Siddarth 的建议，尝试一下这个。如果您有任何问题，请告诉我:

Sub fillArray()
    Dim i As Integer
    Dim aCell As Range, bCell As Range
    Dim arr As Variant

    i = 0
    Set aCell = Sheets("Log").UsedRange.Find(What:=("string"), _
                                             LookIn:=xlValues, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False, _
                                             SearchFormat:=False)
    If Not aCell Is Nothing Then
        Set bCell = aCell
        ReDim Preserve arr(0 To 5, 0 To i)
        arr(0, i) = True 'Boolean
        arr(1, i) = aCell.Value 'String
        arr(2, i) = aCell.Cells.Offset(0, 1).Value
        arr(3, i) = aCell.Cells.Offset(0, 3).Value
        arr(4, i) = aCell.Cells.Offset(0, 4).Value
        arr(5, i) = Year(aCell.Cells.Offset(0, 3).Value)
        i = i + 1
        Do While exitLoop = False
            Set aCell = Sheets("Log").UsedRange.FindNext(after:=aCell)
            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                ReDim Preserve arrSwUb(0 To 5, 0 To i)
                arr(0, i) = True
                arr(1, i) = aCell.Value
                arr(2, i) = aCell.Cells.Offset(0, 1).Value
                arr(3, i) = aCell.Cells.Offset(0, 3).Value
                arr(4, i) = aCell.Cells.Offset(0, 4).Value
                arr(5, i) = Year(aCell.Cells.Offset(0, 3).Value)
                i = i + 1
            Else
                exitLoop = True
            End If
        Loop
    End If
End Sub

注意:在声明中，您有:

Dim aCell, bCell as Range

这与:

相同

Dim aCell as Variant, bCell as Range

一些测试代码来演示上述内容:

Sub testTypes()

    Dim a, b As Integer
    Debug.Print VarType(a)
    Debug.Print VarType(b)

End Sub