Worksheet_Change事件在Sheet2超约890行后失效问题求助

你的代码在第890行之后失效的核心问题出在获取Sheet2最后一行的逻辑错误，导致循环遍历的范围没有覆盖到所有数据行。

核心错误点 #

看这行关键代码：

lRow = Sheet2.Range("A1500").End(xlUp).Value

Range.End(xlUp)返回的是一个单元格对象，你用.Value取的是这个单元格里的内容，而不是它的行号！

举个实际场景：如果Sheet2的A列最后一行数据在第1200行，但A1200单元格里的值是889，那lRow就会被赋值为889，循环只会从2到889执行，后面的890-1200行根本不会被检查，自然不会触发高亮。这就是为什么到890行之后功能失效的直接原因。

正确的写法应该是取这个单元格的行号：

lRow = Sheet2.Range("A1500").End(xlUp).Row

其他潜在问题与优化建议 #

除了这个核心错误，你的代码还有几个可以优化的点，避免后续出现隐性bug：

1. 变量声明不规范
   原代码Dim cRow, cPID, lRow As Long中，只有lRow是Long类型，cRow和cPID会被默认声明为Variant类型，建议明确声明每个变量的类型：

   Dim cRow As Long, cPID As Long, lRow As Long
   Dim cVal As String
   Dim i As Long, j As Long ' 循环变量也要明确声明类型
   

   最好在模块顶部加上Option Explicit，强制所有变量必须声明，避免拼写错误导致的隐性问题。

2. 未处理多单元格修改的情况
   如果用户一次性修改多个单元格（比如选中V2:Y5批量输入），Target会是一个多单元格区域，原代码只处理了Target.Row和Target.Column，会导致逻辑错误。可以加上循环遍历Target中的每个单元格：

   Dim cell As Range
   For Each cell In Intersect(Target, Range("V2:Y1500"))
       ' 把原来的逻辑放到这个循环里，用cell代替Target
   Next cell
   

3. 提升大数据量下的效率
   可以用Find方法快速定位cPID在Sheet2的A列中的位置，代替逐行循环，尤其是数据量较大时能明显提升速度：

   Dim foundCell As Range
   Set foundCell = Sheet2.Range("A:A").Find(What:=cPID, LookIn:=xlValues, LookAt:=xlWhole)
   If Not foundCell Is Nothing Then
       ' 检查该行的12-29列
       For j = 12 To 29
           If Sheet2.Cells(foundCell.Row, j).Value = cVal And Sheet2.Cells(foundCell.Row, j).Value <> "" Then
               Sheet1.Cells(cRow, cell.Column).Interior.Color = 65535
               Exit For ' 找到匹配后退出列循环
           End If
       Next j
   End If
   

修正后的完整代码 #

Option Explicit ' 强制变量声明，避免隐性错误

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim targetRange As Range
    Set targetRange = Intersect(Target, Range("V2:Y1500"))
    If targetRange Is Nothing Then Exit Sub
    
    Dim cell As Range
    Dim cRow As Long, cPID As Long
    Dim cVal As String
    Dim j As Long
    Dim foundCell As Range
    
    Application.ScreenUpdating = False ' 关闭屏幕更新提升运行速度
    On Error GoTo Cleanup ' 出错时恢复屏幕更新
    
    For Each cell In targetRange
        cVal = cell.Value
        cRow = cell.Row
        ' 先清除原有高亮
        Sheet1.Cells(cRow, cell.Column).Interior.Color = xlNone
        cPID = ActiveSheet.Range("A" & cRow).Value
        
        ' 用Find快速定位cPID在Sheet2的位置
        Set foundCell = Sheet2.Range("A:A").Find(What:=cPID, LookIn:=xlValues, LookAt:=xlWhole)
        If Not foundCell Is Nothing Then
            For j = 12 To 29
                If Sheet2.Cells(foundCell.Row, j).Value = cVal And Sheet2.Cells(foundCell.Row, j).Value <> "" Then
                    Sheet1.Cells(cRow, cell.Column).Interior.Color = 65535
                    Exit For ' 找到匹配后退出列循环，无需继续检查
                End If
            Next j
        End If
    Next cell

Cleanup:
    Application.ScreenUpdating = True ' 恢复屏幕更新
End Sub

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