Excel VBA数据处理宏处理400-500行后崩溃排查求助

我编写了一款VBA宏用于处理Excel中的球员数据，核心功能包括：

• 删除无有效球员ID的无效行
• 将错位到下一行的位置、得分数据移至对应球员的正确列

该宏在处理400-500行的测试数据集时运行完全正常，但处理包含900-1000行的完整数据集时直接崩溃。我已尝试ChatGPT给出的常规优化建议（如关闭屏幕更新、禁用事件、避免重复调用End(xlUp)等），但问题仍未解决，希望能排查出崩溃的具体原因。

原始数据示例 #

部分错位数据的原始格式：
| 球员ID | 姓名 | 位置 | 得分 |
|--------|------|------|------|
| 101 | 张三 | | |
| | | 前锋 | 25 |
| 102 | 李四 | 后卫 | 18 |
| 103 | 王五 | | |
| | | 中锋 | 30 |

期望输出 #

修正后的正确格式：
| 球员ID | 姓名 | 位置 | 得分 |
|--------|------|------|------|
| 101 | 张三 | 前锋 | 25 |
| 102 | 李四 | 后卫 | 18 |
| 103 | 王五 | 中锋 | 30 |

宏代码 #

Sub ProcessPlayerData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("球员数据") ' 指定工作表
    Dim lastRow As Long, i As Long
    
    ' 应用优化设置
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 获取初始最后行
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 删除无效行（无球员ID的行）
    For i = lastRow To 2 Step -1
        If Trim(ws.Cells(i, "A").Value) = "" Then
            ws.Rows(i).Delete
        End If
    Next i
    
    ' 重新获取最后行，处理错位数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        ' 判断当前行是否为错位数据行（无ID但有位置/得分）
        If Trim(ws.Cells(i, "A").Value) = "" And Trim(ws.Cells(i, "C").Value) <> "" Then
            ' 将数据移至上一行对应列
            ws.Cells(i - 1, "C").Value = ws.Cells(i, "C").Value
            ws.Cells(i - 1, "D").Value = ws.Cells(i, "D").Value
            ' 删除当前错位行
            ws.Rows(i).Delete
            ' 因删除行，需回退索引避免跳过数据
            i = i - 1
            ' 更新最后行
            lastRow = lastRow - 1
        End If
    Next i
    
    ' 恢复系统设置
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "数据处理完成！"
End Sub

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