动态位置下拉列表变动触发Excel宏的实现方案问询

核心思路 #

• 不再预先指定固定的触发单元格范围，改成判断触发事件的单元格是否为带下拉列表（序列类型数据验证）的单元格
• 可额外验证下拉列表的数据源是否对应第一个工作表的名称列表，避免误触发

修改后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nSearchRow As Integer
    Dim cSearchText As String
    Dim dv As Validation
    
    ' 只处理单个单元格的变更，批量操作直接退出，避免报错
    If Target.Cells.Count > 1 Then Exit Sub
    
    ' 检查目标单元格是否有数据验证，且是下拉列表类型
    On Error Resume Next
    Set dv = Target.Validation
    On Error GoTo 0
    
    If Not dv Is Nothing And dv.Type = xlValidateList Then
        ' 可选：验证下拉列表来源是否指向第一个工作表的名称区域（自行修改Sheet1为实际表名）
        ' If InStr(dv.Formula1, "Sheet1!") > 0 Then
            
            If Not IsEmpty(Target.Value) Then
                cSearchText = Target.Value
                
                On Error Resume Next
                nSearchRow = WorksheetFunction.Match(cSearchText, Worksheets("Available").Range("B1:B50"), 0)
                
                If Err.Number <> 0 Then
                    MsgBox "联系技术支持"
                Else
                    ' 把匹配行的B列内容复制到C列，再清空B列
                    Worksheets("Available").Range("B" & nSearchRow).Copy
                    Worksheets("Available").Cells(nSearchRow, 3).PasteSpecial Paste:=xlPasteValues
                    Worksheets("Available").Range("B" & nSearchRow).ClearContents
                    Application.CutCopyMode = False ' 取消复制状态，避免残留提示
                End If
                On Error GoTo 0
            End If
        ' End If
    End If
End Sub

关键修改说明 #

• 移除了原来固定的KeyCells范围，替换为动态检测带数据验证的下拉单元格
• 增加Target.Cells.Count > 1的判断，防止批量修改时触发错误
• 通过dv.Type = xlValidateList精准识别下拉列表单元格
• 可选的来源验证（注释部分）能进一步缩小触发范围，按需开启即可
• 新增Application.CutCopyMode = False清理复制状态，优化使用体验

注意事项 #

• 确保第二个工作表中生成的下拉列表是通过「数据验证-序列」创建的，否则代码无法识别
• 如果需要更精准的触发条件，取消注释里的来源验证代码，把Sheet1!改成实际存储名称的工作表和区域

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