如何在数组中插入数据（在循环内）？

Question

我有一个插入数据到数组的问题。在程序中，我使用“Data：”值搜索所有单元格。如果出现此值，我跳转到右边的单元格并标记它。我想收集数组中的所有标记值（所有这些都是日期），但是我的代码（如下所示）我有一个错误。我尝试过ReDim并在数组中设置确切数量的对象。我很感激你的帮助。

Sub CheckData()
Dim FindIt As Range
Dim EndIt As Range
Dim StartAddress As String

With Range("A1:A100")
    Set EndIt = .Cells(.Cells.Count)
End With

Set FindIt = Range("A1:A100").Find(what:="Data:", after:=EndIt)

If Not FindIt Is Nothing Then
    StartAddress = FindIt.Address
End If

Dim Tabel() As Variant
Tabel = Array()
i = 0

Do Until FindIt Is Nothing
    Set FindIt = Range("A1:A100").FindNext(after:=FindIt)

    Data = FindIt.Address
    Range(Data).Select
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Interior.ColorIndex = 6

    'Debug.Print ActiveCell.Value
    Tabel(i) = ActiveCell.Value
    i = i + 1
    'Debug.Print i

    If FindIt.Address = StartAddress Then
        Exit Do
    End If

Loop

End Sub

Answer 1

你永远不会调整阵列大小。

Dim Tabel() As Variant

使用ReDim调整动态大小的数组的大小。

ReDim Preserve Tabel(0 To UBound(Tabel)+1)

然而，在循环中这是一个非常低效的事情（你在每次迭代时反复复制相同的元素，一遍又一遍）。

经验法则，如果你从一开始就不知道你需要多少元素，最好使用Collection而不是数组。

Dim items As Collection
Set items = New Collection

'...

items.Add ActiveCell.Value

Answer 2

您也可以使用for循环而不是find（也使用Mat的Mug关于集合的想法）

Sub CheckData1()

Dim ws As Worksheet
Dim searchRng As Range
Dim cell As Range
Dim tabel As Collection 'incorrectly spelt table?

Set ws = ActiveSheet
Set tabel = New Collection
Set searchRng = ws.Range("A1:A100")

For Each cell In searchRng.Cells
    If cell.Value = "Data:" Then
        tabel.Add cell.Offset(, 1)
        cell.Offset(, 1).Interior.ColorIndex = 6 'If you still need it highlighted
    End If
Next

End Sub