求助：VBA VLookup代码导致Excel崩溃且执行缓慢问题（需VBA代码解决方案，拒绝单元格公式）

看了你的代码，我发现几个核心问题直接导致了崩溃和运行缓慢的情况，咱们一步步来修复：

原代码的主要问题 #

• 无限制的事件触发：你的Worksheet_Change事件没有限定触发范围，只要工作表任何单元格变化就会调用lookup，频繁触发会快速耗尽Excel资源
• 低效的查找范围：每次都在B2:H99999这种超大区域查找，而且用多单元格（A11:C11）作为查找值，WorksheetFunction.VLookup本就不适合这种场景
• 事件逻辑错误：ThisWorkbook里的事件代码存在语法问题（比如Sh.Name未定义），判断工作表的方式效率极低，添加数据的逻辑也容易出错
• 宽泛的错误处理：On Error Resume Next会掩盖其他潜在问题，给调试带来极大阻碍

优化后的解决方案 #

1. 修正Invoice工作表的Worksheet_Change事件与查找逻辑 #

我们只在目标单元格（A11）变化时才触发查找，改用更高效的Range.Find替代VLookup，同时缩小查找范围（只用到有实际数据的区域，而非固定99999行）：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅当A11单元格变化时执行查找
    If Not Intersect(Target, Me.Range("A11")) Is Nothing Then
        ' 关闭事件触发，防止递归调用消耗资源
        Application.EnableEvents = False
        Call LookupCustomerData
        Application.EnableEvents = True
    End If
End Sub

Sub LookupCustomerData()
    Dim shCustomer As Worksheet
    Dim shInvoice As Worksheet
    Dim searchValue As Variant
    Dim foundRow As Range
    Dim lastRow As Long
    
    Set shCustomer = ThisWorkbook.Sheets("Customer")
    Set shInvoice = ThisWorkbook.Sheets("Invoice")
    searchValue = shInvoice.Range("A11").Value ' 用A11的值作为唯一查找键（请确认这是你的客户标识）
    
    ' 先清空结果区域，避免残留旧数据
    shInvoice.Range("A12:C13").ClearContents
    
    ' 如果查找值为空，直接退出，减少无效操作
    If IsEmpty(searchValue) Then Exit Sub
    
    ' 获取Customer表中B列的最后一行，动态缩小查找范围
    lastRow = shCustomer.Cells(shCustomer.Rows.Count, "B").End(xlUp).Row
    
    ' 使用Range.Find高效定位数据
    Set foundRow = shCustomer.Range("B2:B" & lastRow).Find( _
        What:=searchValue, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        MatchCase:=False)
    
    If Not foundRow Is Nothing Then
        ' 找到后批量填充对应数据（原代码取第5、6列，对应Customer表的F、G列）
        shInvoice.Range("A12:C12").Value = shCustomer.Cells(foundRow.Row, "F").Resize(1, 3).Value
        shInvoice.Range("A13:C13").Value = shCustomer.Cells(foundRow.Row, "G").Resize(1, 3).Value
    Else
        ' 未找到时返回错误值
        shInvoice.Range("A12:C12").Value = CVErr(xlErrNA)
        shInvoice.Range("A13:C13").Value = CVErr(xlErrNA)
    End If
End Sub

2. 修正ThisWorkbook的Worksheet_Change事件 #

原代码逻辑存在错误，我们调整后确保只在Invoice表的A11变化时添加数据，并且高效定位最后一行：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    
    Set targetSheet = ThisWorkbook.Sheets("Invoice")
    
    ' 仅处理Invoice表的A11单元格变化
    If Sh.Name = targetSheet.Name And Target.Address = "$A$11" Then
        ' 定位A列最后一行，避免覆盖已有数据
        lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
        targetSheet.Cells(lastRow + 1, "A").Value = Target.Value
    End If
End Sub

额外性能优化建议 #

• 关闭屏幕刷新：执行批量操作时可添加Application.ScreenUpdating = False，操作完成后再设为True，减少界面卡顿
• 临时禁用自动计算：如果表格有大量公式，可临时关闭自动计算：Application.Calculation = xlCalculationManual，完成后改回xlCalculationAutomatic
• 确认查找键唯一性：确保Customer表的B列是唯一客户标识，若存在重复值，可结合FindNext处理多结果场景

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