Excel实现：B列选下拉值时强制填充同I列并支持取消操作

实现思路 #

通过工作表的Worksheet_Change事件监控B列单元格变化，当用户在B列选择下拉值后，弹出InputBox要求填写对应行I列内容；若用户取消输入或未填写，则清除B列的选择，保证两列内容的关联性。

完整代码 #

将以下代码粘贴到目标工作表的代码模块中（右键工作表标签→「查看代码」，在弹出的VBA编辑器中粘贴）：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅处理B列单个单元格的变化
    If Target.Column = 2 And Target.Cells.Count = 1 Then
        Dim inputContent As String
        Dim bOriginalValue As Variant
        
        ' 禁用事件触发，避免循环执行
        Application.EnableEvents = False
        
        bOriginalValue = Target.Value
        
        ' 仅当B列有选中内容时触发输入框
        If bOriginalValue <> "" Then
            inputContent = InputBox("请填写同一行I列的内容：", "必填项提示", "")
            
            If inputContent = "" Then
                ' 用户取消或未填写，清除B列选择
                Target.ClearContents
            Else
                ' 将输入内容写入对应行的I列
                Me.Cells(Target.Row, 9).Value = inputContent
            End If
        End If
        
        ' 恢复事件监听
        Application.EnableEvents = True
    End If
End Sub

关键说明 #

1. 事件监听范围：代码限定只处理B列（Target.Column = 2）的单个单元格修改，避免批量操作时误触发。
2. 事件禁用与恢复：修改单元格内容会再次触发Worksheet_Change事件，因此先禁用Application.EnableEvents，操作完成后再恢复，防止循环执行。
3. 输入逻辑处理：
   • 若用户在InputBox中未输入内容或点击「取消」，清除当前行B列的选择；
   • 若用户填写了内容，则直接赋值到同一行的I列（Column = 9）。

可选优化（仅针对下拉选择触发） #

如果只想在用户选择B列的下拉列表选项时触发逻辑，而非手动输入，可添加数据验证类型判断：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 And Target.Cells.Count = 1 Then
        ' 新增：判断当前单元格是否是数据验证下拉列表
        On Error Resume Next ' 防止单元格无数据验证时报错
        Dim validationType As XlDVType
        validationType = Target.Validation.Type
        On Error GoTo 0
        
        If validationType = xlValidateList Then
            Dim inputContent As String
            Dim bOriginalValue As Variant
            
            Application.EnableEvents = False
            bOriginalValue = Target.Value
            
            If bOriginalValue <> "" Then
                inputContent = InputBox("请填写同一行I列的内容：", "必填项提示", "")
                
                If inputContent = "" Then
                    Target.ClearContents
                Else
                    Me.Cells(Target.Row, 9).Value = inputContent
                End If
            End If
            
            Application.EnableEvents = True
        End If
    End If
End Sub

内容的提问来源于stack exchange，提问作者Simon.G