如何通过For-Next循环声明变量并简化Excel VBA表格数据加载代码

Macro2（For-Next循环加载Variant变量）问题修复 #

原问题：通过For-Next循环声明Variant变量时出错，无法正确遍历表格第三列。

常见错误示例 #

Sub Macro2()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim varData As Variant
    Dim i As Integer
    
    For Each ws In ThisWorkbook.Worksheets
        ' 错误：未先将普通数据转为Table，或循环中错误处理Variant赋值
        Set tbl = ws.ListObjects(1)
        ' 错误：逐个单元格读取效率低且逻辑冗余
        For i = 1 To tbl.ListRows.Count
            varData = tbl.ListColumns(3).DataBodyRange(i).Value
            Debug.Print varData
        Next i
    Next ws
End Sub

修复后的Macro2 #

Sub Macro2_Fixed()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim varData As Variant
    Dim rowIdx As Long
    
    ' 遍历工作簿内所有工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 自动将普通数据转为Excel Table（避免无Table时报错）
        On Error Resume Next
        Set tbl = ws.ListObjects.Add(xlSrcRange, ws.UsedRange, , xlYes)
        On Error GoTo 0
        
        If Not tbl Is Nothing Then
            ' 一次性把第三列数据加载到Variant数组（大幅提升效率）
            varData = tbl.ListColumns(3).DataBodyRange.Value
            
            ' 遍历数组输出数据
            For rowIdx = LBound(varData, 1) To UBound(varData, 1)
                Debug.Print varData(rowIdx, 1)
            Next rowIdx
        End If
    Next ws
End Sub

修复点说明 #

• 新增自动转Table逻辑，适配原本无Table的工作表
• 改用整列一次性加载数组替代逐个单元格读取，效率更高
• 用LBound/UBound判断数组边界，适配不同数据量的表格

Macro3（Scripting.Dictionary实现）问题修复 #

原问题：使用Scripting.Dictionary时无法正确存储或遍历第三列数据。

常见错误示例 #

Sub Macro3()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim dict As New Scripting.Dictionary
    Dim cell As Range
    
    For Each ws In ThisWorkbook.Worksheets
        Set tbl = ws.ListObjects(1)
        ' 错误：未处理空值和重复键，易触发运行时错误
        For Each cell In tbl.ListColumns(3).DataBodyRange
            dict.Add cell.Value, cell.Row
        Next cell
    Next ws
    
    ' 错误：遍历方式错误，无法正确读取Dictionary内容
    For Each cell In dict
        Debug.Print cell
    Next cell
End Sub

修复后的Macro3 #

Sub Macro3_Fixed()
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim dict As Scripting.Dictionary
    Dim varData As Variant
    Dim rowIdx As Long
    Dim key As Variant
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 每个工作表初始化新的Dictionary，避免数据混淆
        Set dict = New Scripting.Dictionary
        ' 自动转为Table
        On Error Resume Next
        Set tbl = ws.ListObjects.Add(xlSrcRange, ws.UsedRange, , xlYes)
        On Error GoTo 0
        
        If Not tbl Is Nothing Then
            ' 加载第三列数据到数组
            varData = tbl.ListColumns(3).DataBodyRange.Value
            
            ' 填充Dictionary，处理空值与重复键
            For rowIdx = LBound(varData, 1) To UBound(varData, 1)
                Dim cellValue As Variant
                cellValue = varData(rowIdx, 1)
                
                ' 跳过空值
                If Not IsEmpty(cellValue) Then
                    ' 重复键时追加行号，而非报错
                    If dict.Exists(cellValue) Then
                        dict(cellValue) = dict(cellValue) & ", " & tbl.DataBodyRange(rowIdx, 1).Row
                    Else
                        dict.Add cellValue, tbl.DataBodyRange(rowIdx, 1).Row
                    End If
                End If
            Next rowIdx
            
            ' 正确遍历Dictionary输出内容
            For Each key In dict.Keys
                Debug.Print "值: " & key & " | 所在行号: " & dict(key)
            Next key
        End If
    Next ws
End Sub

修复点说明 #

• 每个工作表单独初始化Dictionary，避免跨表数据污染
• 增加空值过滤和重复键处理逻辑，解决运行时报错问题
• 用数组加载数据后填充Dictionary，提升运行效率
• 修正遍历方式，通过Keys集合正确读取Dictionary的键值对

内容的提问来源于stack exchange，提问作者Dr. Somebody