如何用VBA的For Each循环收集多工作表变量并在其他工作表显示

需求：从单个Excel文件中数量可变的工作表里提取B1单元格的数值，将所有提取到的值显示在名为OVERALL的工作表的B列（从B2开始）。

用户原始代码（借鉴Python写法，存在VBA语法错误）：

Sub vba_loop_sheets()

    Dim ws As Worksheet
    Dim list_of_values

    For Each ws In ThisWorkbook.Worksheets
        list_of_values.Extend (ws.Range("B1").Value)
    Next ws

    OVERALL.Range("B2").Value = list_of_values

End Sub

代码问题分析 #

1. list_of_values未声明类型也未初始化，VBA无法识别它为可存储多个值的容器
2. VBA中没有Extend方法（这是Python列表的语法），无法直接用这种方式添加元素
3. 循环未排除OVERALL工作表，会把目标表自身的B1值也提取进去
4. 直接给单个单元格赋值数组，无法将所有值按列显示

修正后的代码 #

Sub vba_loop_sheets()
    Dim ws As Worksheet
    Dim list_of_values() As Variant ' 声明为变体数组，用于存储提取的数值
    Dim i As Integer ' 计数器，记录数组元素数量
    
    i = 0 ' 初始化计数器
    For Each ws In ThisWorkbook.Worksheets
        ' 跳过存储结果的OVERALL工作表
        If ws.Name <> "OVERALL" Then
            i = i + 1
            ' 扩展数组大小并保留已有数据
            ReDim Preserve list_of_values(1 To i)
            ' 将当前工作表B1的值存入数组
            list_of_values(i) = ws.Range("B1").Value
        End If
    Next ws
    
    ' 将数组转成列方向，写入OVERALL工作表的B2开始区域
    Sheets("OVERALL").Range("B2:B" & 1 + UBound(list_of_values)).Value = Application.Transpose(list_of_values)
End Sub

关键说明 #

• ReDim Preserve：VBA中扩展数组的专用语句，Preserve参数确保之前存入的数据不会被清空
• Application.Transpose：将一维数组转成列方向，这样才能按列写入Excel单元格
• 跳过OVERALL工作表：避免提取结果表自身的数据，防止重复或错误
• 若要跳过空值，可在i = i + 1前添加判断：If ws.Range("B1").Value <> "" Then

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