VBA开发求助：提取F列含Total的相邻单元格值到数组并写入Sheet2

没问题，我帮你把这个VBA子程序完善好，完全贴合你的需求～先给你完整的可运行代码，再拆解关键部分帮你理解：

Sub MatrixFill()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim totalValues() As Variant
    Dim arrIndex As Integer
    
    ' 指定源工作表和目标工作表，可根据实际修改名称
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsDest = ThisWorkbook.Worksheets("Sheet2")
    
    ' 获取源表F列的最后一行行号，避免遍历无效行
    lastRow = wsSource.Cells(wsSource.Rows.Count, "F").End(xlUp).Row
    
    ' 初始化数组索引
    arrIndex = 0
    
    ' 遍历F列所有有效单元格，查找包含"Total"的内容
    For Each cell In wsSource.Range("F1:F" & lastRow)
        ' 不区分大小写查找包含"Total"的单元格，要严格区分就去掉vbTextCompare
        If InStr(1, cell.Value, "Total", vbTextCompare) > 0 Then
            ' 动态扩展数组容量，保留已有数据
            ReDim Preserve totalValues(arrIndex)
            ' 取当前单元格左侧相邻单元格的值（要右侧就改成cell.Offset(0, 1).Value）
            totalValues(arrIndex) = cell.Offset(0, -1).Value
            arrIndex = arrIndex + 1
        End If
    Next cell
    
    ' 将数组无空白间隔写入Sheet2的第二列（B列）
    If arrIndex > 0 Then
        ' 转置一维数组为列方向，一次性写入提升效率
        wsDest.Range("B1:B" & arrIndex).Value = Application.Transpose(totalValues)
    Else
        MsgBox "未找到包含'Total'的单元格！"
    End If
    
    ' 释放对象变量，避免内存占用
    Set wsSource = Nothing
    Set wsDest = Nothing
End Sub

关键细节说明 #

• 工作表对象化：用变量指定源表和目标表，比直接硬编码工作表名称更灵活，后续修改只需改一处；
• 高效遍历：先获取F列最后一行，只遍历有数据的行，避免浪费资源；
• 模糊匹配控制：用InStr实现包含式查找，vbTextCompare参数让查找不区分大小写，要是需要精确匹配（单元格内容完全等于"Total"），可以把判断改成cell.Value = "Total"；
• 动态数组：用ReDim Preserve动态扩展数组，确保能装下所有找到的相邻单元格值；
• 相邻单元格调整：代码默认取F列单元格的左侧相邻单元格（E列），如果你的需求是右侧（G列），把cell.Offset(0, -1).Value改成cell.Offset(0, 1).Value即可；
• 高效写入：用Application.Transpose把一维数组转成列方向，一次性写入单元格，比循环逐个写入快很多；
• 友好提示：如果没找到任何匹配的"Total"单元格，会弹出提示框告知用户。

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