Excel VBA数组存储条件数据写入工作表列异常问题求助

嘿，能看出来你正试着用VBA把簿记流程自动化，这绝对是个能提升效率的好方向！不过你的代码里有几个逻辑小bug，导致了最后只输出重复的最后一个单元格地址，而且数组元素打印不出来的问题。咱们来一步步梳理并修正：

先说说你的代码里的核心问题： #

• 循环变量冲突：你在外层For i = 1 To count和内层的两个For i = ...循环里都用了同一个变量i，这会彻底打乱循环的计数逻辑，导致数组赋值完全混乱。
• 数组赋值逻辑错误：每次找到值为"abc"的单元格时，你都用一个循环把数组的所有Arr(i,1)都设为当前单元格地址，这就意味着之前找到的地址会被后续的单元格地址覆盖，最后数组里全是最后一个符合条件的地址。
• 数组写入工作表的方式不对：Sheet5.Cells(i + 16, 10).Value = Arr这种写法会把整个数组一次性赋值到每个单元格，而不是逐个写入数组元素。

修正后的代码 #

Sub ListSpecificVals()
    Dim Arr() As Variant
    Dim datarange As Range, cell As Range ' 修正变量类型声明：原代码中datarange默认是Variant，现在明确为Range
    Dim count As Long
    Dim arrIndex As Long ' 单独用一个变量跟踪数组索引，避免和循环变量冲突
    
    Set datarange = Sheet5.Range("a17:f28")
    count = Application.WorksheetFunction.CountIf(datarange, "abc")
    
    ' 提前判断：如果没有符合条件的单元格，直接退出避免报错
    If count = 0 Then
        MsgBox "没有找到值为abc的单元格"
        Exit Sub
    End If
    
    ReDim Arr(1 To count, 1 To 1) ' 只存地址，第二维度设为1即可
    arrIndex = 1 ' 初始化数组起始索引
    
    MsgBox "找到" & count & "个值为abc的单元格"
    
    For Each cell In datarange
        If cell.Value = "abc" Then
            cell.Offset(0, 1).Value = 33 ' 保留你原有的业务逻辑
            Arr(arrIndex, 1) = cell.Address ' 依次将地址存入数组对应位置
            Debug.Print cell.Address & " = " & cell.Offset(0, 1).Value ' 合并打印更清晰
            arrIndex = arrIndex + 1 ' 索引自增，准备存储下一个地址
        End If
    Next cell
    
    ' 一次性将数组写入工作表，效率远高于逐个赋值
    Sheet5.Cells(17, 10).Resize(count, 1).Value = Arr
End Sub

修正点说明： #

1. 新增arrIndex变量：专门用来跟踪数组的当前存储位置，彻底避免循环变量冲突，确保每个符合条件的地址都能依次存入数组。
2. 优化数组初始化：因为只需要存储单元格地址，数组第二维度设为1足够，结构更简洁。
3. 高效写入工作表：用Resize配合数组一次性写入，比逐个单元格赋值效率高很多，数据量大时优势更明显。
4. 增加空值判断：如果没有找到目标单元格，提前退出程序，避免后续数组操作出现报错。
5. 修正变量声明：原代码中Dim datarange, cell As Range只有cell是Range类型，datarange默认是Variant，现在明确类型后代码更严谨。

现在再运行这个代码，就能把所有符合条件的单元格地址依次写入第10列（J列）的对应位置，Debug.Print也能正常输出每个单元格的信息啦。

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