嘿，我一眼就揪出你代码里的问题了——这是VBA二维数组使用ReDim Preserve时的经典坑！

问题根源 #

VBA的ReDim Preserve有个死规则：它只能修改数组的最后一维的大小。你现在定义的数组是arr(1 To size, 1 To 4)，这里行数是第一维，列数是第二维。当你第二次执行ReDim Preserve arr(1 To size, 1 To 4)时，你在修改第一维（行数）的长度，直接违反了Preserve的限制，所以触发了「下标越界」错误。

解决方案 #

给你两个实用的修复思路，按需选择：

思路1：调换数组维度

把数组改成arr(1 To 4, 1 To size)，让行数变成最后一维。这样每次新增记录时，用ReDim Preserve修改最后一维的长度就完全合法了。如果最后需要原来的行列结构，用Application.Transpose(arr)转置回来就行。

思路2：改用集合存储（更灵活）

用VBA的Collection对象来存储每行的数据，最后再把集合转成数组。这种方式不用纠结数组维度的问题，代码可读性和稳定性都更高。

优化后的代码示例（思路1） #

我顺便帮你改掉了代码里的ActiveCell和Select操作（这些操作很容易导致代码崩溃），还修正了变量声明的小疏漏：

Sub test()
    Dim arr() As Variant
    Dim i As Integer, size As Integer
    Dim targetCell As Range
    Dim back As String
    
    ' 处理TextBox1的搜索
    Set targetCell = Columns(1).Find(UserForm1.TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not targetCell Is Nothing Then
        back = targetCell.Address
        Do Until targetCell.Value = "End"
            size = size + 1
            ' 调换维度：列在前，行在后，适配Preserve规则
            ReDim Preserve arr(1 To 4, 1 To size)
            i = 0
            ' 限制最多取4列，避免越界
            Do Until targetCell.Value = "End" Or i >= 4
                i = i + 1
                arr(i, size) = targetCell.Value
                Set targetCell = targetCell.Offset(0, 1)
            Loop
            ' 回到下一行的A列继续循环
            Set targetCell = Range(back).Offset(1, 0)
            back = targetCell.Address
        Loop
    End If
    
    ' 处理TextBox2的搜索
    Set targetCell = Columns(1).Find(UserForm1.TextBox2.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not targetCell Is Nothing Then
        back = targetCell.Address
        Do Until targetCell.Value = "End"
            size = size + 1
            ReDim Preserve arr(1 To 4, 1 To size)
            i = 0
            Do Until targetCell.Value = "End" Or i >= 4
                i = i + 1
                arr(i, size) = targetCell.Value
                Set targetCell = targetCell.Offset(0, 1)
            Loop
            Set targetCell = Range(back).Offset(1, 0)
            back = targetCell.Address
        Loop
    End If
    
    ' 如需恢复原行列结构（行在前，列在后），执行转置
    arr = Application.Transpose(arr)
End Sub

额外小提醒 #

• 变量声明要明确：Dim i, size As Integer其实是i为Variant类型，size为Integer，应该写成Dim i As Integer, size As Integer。
• 用Range.Find代替循环查找单元格，效率更高，也更不容易出错。
• 循环里增加i >=4的判断，避免数组列数超出预设的4列范围。

内容的提问来源于stack exchange，提问作者vonski