使用Variant数组处理绩效数据时遇VBA报错求助

让咱们一步步拆解你的问题，先搞定那些烦人的错误，再优化你的代码效率：

一、错误原因分析 #

1. Subscript out of Range（下标越界） #

这个错误大概率来自两个核心点：

• arrData未正确初始化：如果你的tbl_g2Measure表格没有数据（DataBodyRange为空），arrData = loData.DataBodyRange会把arrData变成单个Variant值，而非二维数组，此时调用LBound(arrData)或UBound(arrData)就会直接触发下标越界。
• lRowCount取值不可靠：你用Range("A6").Value控制外层循环次数，如果这个值大于A8开始实际存在的员工行数，外层循环到后期时，Selection.Offset(1,0)会选到工作表空白区域甚至超出范围，后续引用Selection相关单元格时也会出问题。

2. Next without For/End Select without Select #

你说相关语句都正确编写了，那大概率是代码缩进混乱导致VBA编辑器误判结构，或是前面的数组错误中断了代码执行，让编辑器误以为结构不完整。先解决数组和循环的问题，这个错误通常会跟着消失。

二、优化后的代码 #

我帮你重写了代码，去掉了低效的Select/Selection，用字典快速汇总数据，同时避免了数组初始化的坑：

Sub createScore()
    Dim loData As ListObject
    Dim arrData() As Variant
    Dim dictSummary As Object
    Dim wsSummary As Worksheet
    Dim lastRow As Long, i As Long
    Dim empName As String, measureResult As String
    
    ' 初始化对象
    Set loData = Sheets("DataMeasure").ListObjects("tbl_g2Measure")
    Set wsSummary = ActiveSheet ' 假设汇总表是当前激活的工作表，可改为具体工作表名
    Set dictSummary = CreateObject("Scripting.Dictionary")
    
    ' 检查数据表格是否有内容
    If loData.DataBodyRange Is Nothing Then
        MsgBox "绩效数据表中没有数据！", vbExclamation
        Exit Sub
    End If
    
    ' 将数据存入数组
    arrData = loData.DataBodyRange.Value
    
    ' 第一步：用字典快速汇总每个员工的HIT次数
    For i = LBound(arrData) To UBound(arrData)
        empName = arrData(i, 2) ' 第2列是员工姓名
        measureResult = arrData(i, 8) ' 第8列是绩效结果
        
        If measureResult = "HIT" Then
            ' 如果字典里没有该员工，初始化为1，否则加1
            If dictSummary.Exists(empName) Then
                dictSummary(empName) = dictSummary(empName) + 1
            Else
                dictSummary(empName) = 1
            End If
        End If
    Next i
    
    ' 第二步：将汇总结果写入工作表（从A8开始往下）
    lastRow = wsSummary.Range("A" & wsSummary.Rows.Count).End(xlUp).Row
    ' 从A8开始，覆盖已有数据或追加
    For i = 8 To lastRow
        empName = wsSummary.Range("A" & i).Value
        If dictSummary.Exists(empName) Then
            wsSummary.Range("D" & i).Value = dictSummary(empName) ' 第D列对应原来的Offset(0,3)
        Else
            wsSummary.Range("D" & i).Value = 0 ' 无HIT记录则设为0
        End If
    Next i
    
    MsgBox "得分汇总完成！", vbInformation
End Sub

三、代码改进点说明 #

• 去掉Select/Selection：直接引用单元格对象，避免因工作表切换或用户操作导致的错误，同时大幅提升代码运行速度。
• 用字典替代嵌套循环：13000行数据用嵌套循环会非常慢，字典的查找是O(1)时间复杂度，汇总效率提升几十倍。
• 增加数据检查：提前判断DataBodyRange是否为空，避免数组初始化错误。
• 明确单元格引用：不再依赖Selection的偏移，直接用列号定位，代码逻辑更清晰。

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