Excel VBA需求：根据E列内容，点击J列打开对应指定工作表

需求说明 #

点击J列（J4:J153）单元格时：

• 若对应行E列单元格包含Design、Junior、Fresh、designer任一文本，打开并切换到「Employee Review Design」工作表，将对应员工信息写入该表C3单元格
• 若E列是其他内容，则打开并切换到「Employee Review」工作表，同样将员工信息写入该表C3单元格

附加需求：点击D列（D4:D153）单元格时，将D4到最后一行的区域定义为名称fullnames

原代码 #

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     Dim myRange As Range
     Dim myCell As Range
     If Not Intersect(Target, Range("J4:J153")) Is Nothing Then
     If Target.Value <> "" Then
       employee = Target.Offset(0, -7).Value
           Set myRange = Range("E4:E150")
           For Each myCell In myRange
           If myCell Like "*Design*" Or _
               myCell Like "*Junior*" Or _
               myCell Like "*Fresh*" Or _
               myCell Like "*designer*" Then
        Sheets("Employee Review Design").Visible = True
        Sheets("Employee Review Design").unprotect "1234"
        Sheets("Employee Review Design").Range("C3").Value = employee
        Sheets("Employee Review Design").Activate
        Sheets("Employee Review Design").protect "1234"
      Else
        Sheets("Employee Review").Visible = True
        Sheets("Employee Review").unprotect "1234"
        Sheets("Employee Review").Range("C3").Value = employee
        Sheets("Employee Review").Activate
        Sheets("Employee Review").protect "1234"
    End If
    Next myCell
    End If
If Not Intersect(Target, Range("D4:D153")) Is Nothing Then
    Set fnameRange = Range("$D$4:" & Range("D4").End(xlDown).Address)
    ThisWorkbook.Names.Add Name:="fullnames", RefersTo:=fnameRange
End If
End If
End Sub

问题排查与优化 #

原代码核心问题 #

1. 逻辑错误：每次点击J列单元格时，循环遍历E4:E150所有单元格，导致多次执行工作表切换和赋值，实际应该只判断当前点击行的E列内容
2. 条件冗余：*Design*和*designer*可以合并为不区分大小写的判断
3. 代码冗余：重复调用Sheets("XXX")，缺乏复用性
4. 未处理多选场景：选中J列多个单元格时会触发错误
5. 名称定义缺陷：Range("D4").End(xlDown)遇空行会提前终止，无法覆盖全部有效数据

优化后的代码 #

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim employee As String
    Dim targetRow As Long
    Dim reviewSheet As Worksheet
    
    ' 处理J列点击事件
    If Not Intersect(Target, Me.Range("J4:J153")) Is Nothing Then
        ' 仅处理单个单元格选中的情况
        If Target.Cells.Count = 1 And Target.Value <> "" Then
            targetRow = Target.Row
            employee = Me.Cells(targetRow, "A").Value ' Offset(0,-7)对应A列，直接用列名更清晰
            
            ' 判断当前行E列内容
            Select Case True
                Case Me.Cells(targetRow, "E") Like "*[Dd]esign*", _
                     Me.Cells(targetRow, "E") Like "*Junior*", _
                     Me.Cells(targetRow, "E") Like "*Fresh*"
                    Set reviewSheet = ThisWorkbook.Sheets("Employee Review Design")
                Case Else
                    Set reviewSheet = ThisWorkbook.Sheets("Employee Review")
            End Select
            
            ' 统一操作目标工作表
            With reviewSheet
                .Visible = True
                .Unprotect "1234"
                .Range("C3").Value = employee
                .Activate
                .Protect "1234"
            End With
        End If
    End If
    
    ' 处理D列名称定义事件
    If Not Intersect(Target, Me.Range("D4:D153")) Is Nothing Then
        Dim lastRow As Long
        lastRow = Me.Cells(Me.Rows.Count, "D").End(xlUp).Row
        ' 先删除旧名称避免重复定义报错
        On Error Resume Next
        ThisWorkbook.Names("fullnames").Delete
        On Error GoTo 0
        ThisWorkbook.Names.Add Name:="fullnames", RefersTo:=Me.Range("D4:D" & lastRow)
    End If
End Sub

优化点说明 #

• 精准匹配行：通过targetRow获取当前点击行，直接判断该行E列内容，消除无效循环
• 简化条件：用*[Dd]esign*同时匹配大小写，减少重复条件
• 代码复用：用With块统一处理工作表操作，减少冗余代码
• 增加边界判断：限制仅处理单个单元格选中的情况，避免多选报错
• 修复名称定义：用Rows.Count获取最后一行，避免空行截断，同时删除旧名称防止冲突
• 可读性提升：用变量明确标识关键元素，添加注释说明逻辑

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