VBA ReDim多维动态数组失效求助：仅存储首个匹配值

核心问题排查与修复 #

• 必须给ReDim加上Preserve关键字
  动态数组扩容时，如果不加Preserve，之前存储的数据会被直接清空。正确写法应为：

  ReDim Preserve arr(1 To nbCat, 1 To 16)
  

  注意：Preserve仅支持修改数组的最后一维大小，一维数组无限制；二维数组需固定非最后一维的长度（比如这里固定16列，只扩容行数）。

• 确保数组写入索引与nbCat同步
  既然Locals窗口显示nbCat已更新，说明计数逻辑没问题，但可能写入数组时用了固定索引（比如始终写arr(1, col)）。正确的写法是每次匹配成功后，用当前递增后的nbCat作为行索引写入：

  nbCat = nbCat + 1
  ReDim Preserve arr(1 To nbCat, 1 To 16)
  ' 写入16个值到数组的第nbCat行
  For col = 1 To 16
      arr(nbCat, col) = pbiRow.Range(col + 1).Value ' 假设值从CatMarketPBI的第2列开始
  Next col
  

• 修正遍历与匹配逻辑
  适配你的两个ListObject场景的完整示例代码：

  Sub CollectMatchedValues()
      Dim ws As Worksheet
      Dim completeList As ListObject, CatMarketPBI As ListObject
      Dim clRow As ListRow, pbiRow As ListRow
      Dim catID As Variant
      Dim nbCat As Integer
      Dim arr() As Variant
      Dim col As Integer
      
      ' 假设表在当前活动工作表，可根据实际修改
      Set ws = ActiveSheet
      Set completeList = ws.ListObjects("completeList")
      Set CatMarketPBI = ws.ListObjects("CatMarketPBI")
      
      nbCat = 0
      
      ' 遍历completeList的CATID
      For Each clRow In completeList.ListRows
          catID = clRow.Range(completeList.ListColumns("CATID").Index).Value
          
          ' 在CatMarketPBI中匹配Row Label
          For Each pbiRow In CatMarketPBI.ListRows
              If pbiRow.Range(CatMarketPBI.ListColumns("Row Label").Index).Value = catID Then
                  nbCat = nbCat + 1
                  ' 扩容数组并保留已有数据
                  ReDim Preserve arr(1 To nbCat, 1 To 16)
                  
                  ' 写入16个对应值（假设值在Row Label列之后的16列）
                  For col = 1 To 16
                      arr(nbCat, col) = pbiRow.Range(CatMarketPBI.ListColumns("Row Label").Index + col).Value
                  Next col
                  
                  Exit For ' 找到匹配后退出内层循环，避免重复匹配
              End If
          Next pbiRow
      Next clRow
      
      ' 验证结果，比如输出到工作表
      ' ws.Range("A1").Resize(nbCat, 16).Value = arr
  End Sub
  

• 检查数组初始化方式
  不要提前给数组固定大小，初始时应声明为空数组：Dim arr() As Variant，而不是Dim arr(1 To 1, 1 To 16)，否则第一次扩容可能覆盖初始值。

额外验证技巧 #

在Locals窗口中查看数组的UBound(arr, 1)是否等于nbCat：

• 如果不等，说明ReDim语句执行有问题（比如拼写错误、维度错误）；
• 如果相等但对应行数据为空，说明写入时的单元格引用错误（比如列索引取错了）。

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