实现Table18同行Group1与Group2单元格互斥输入的VBA代码求助

要实现Table18中任意选中行的Group1（第2列）和Group2（第3列）不能同时输入数据的需求，应该用工作表的Worksheet_Change事件（自动响应输入操作），修正后的代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As ListObject
    Dim targetRow As Long
    Dim group1Cell As Range, group2Cell As Range
    
    ' 定位到Table18表格
    Set tbl = Me.ListObjects("Table18")
    If tbl Is Nothing Then Exit Sub ' 表格不存在则直接退出
    
    ' 检查输入的单元格是否在Group1或Group2列范围内
    If Not Intersect(Target, tbl.ListColumns(2).DataBodyRange) Is Nothing Then
        targetRow = Target.Row - tbl.HeaderRowRange.Row
        Set group1Cell = tbl.ListColumns(2).DataBodyRange.Cells(targetRow)
        Set group2Cell = tbl.ListColumns(3).DataBodyRange.Cells(targetRow)
    ElseIf Not Intersect(Target, tbl.ListColumns(3).DataBodyRange) Is Nothing Then
        targetRow = Target.Row - tbl.HeaderRowRange.Row
        Set group1Cell = tbl.ListColumns(2).DataBodyRange.Cells(targetRow)
        Set group2Cell = tbl.ListColumns(3).DataBodyRange.Cells(targetRow)
    Else
        Exit Sub ' 输入不在指定列，直接退出
    End If
    
    ' 判断当前行的两个单元格是否同时有值
    If Trim(group1Cell.Value) <> "" And Trim(group2Cell.Value) <> "" Then
        Application.EnableEvents = False ' 禁用事件避免循环触发
        Target.Value = "" ' 清空错误输入的内容
        MsgBox "Group1和Group2不能同时输入数据，请仅保留其中一项。", vbExclamation, "输入错误"
        Application.EnableEvents = True ' 重新启用事件
    End If
End Sub

原代码的问题说明 #

• 触发逻辑错误：原代码是普通子程序，需要手动运行，无法自动响应输入；且ActiveCell = rng2是拿单个单元格和整列范围比较，永远不会成立。
• 行定位错误：直接用rng.Cells.Value取整列的值，没有定位到当前选中行的对应单元格。
• 错误处理缺失：没有处理同时输入的情况（比如清空错误内容），也没禁用事件避免循环触发。

使用步骤 #

1. 打开包含Table18的工作表，右键点击工作表标签，选择查看代码。
2. 将上述代码粘贴到弹出的VBA编辑器窗口中。
3. 返回Excel，在Table18的Group1或Group2列输入数据时，会自动检查并阻止同时输入的操作。

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