点击活动下拉列表同步同行所有下拉列表选择的VBA实现需求

我太懂这种重复操作的痛苦了——同行一堆选项相同的下拉列表，每次挨个点简直浪费时间！之前你试的方法要么有局限性要么触发无限循环，这里给你一段精准解决问题的VBA代码，一步到位：

代码实现（工作表级事件） #

首先，把这段代码放到你需要功能的对应工作表模块里（右键工作表标签→「查看代码」，粘贴进去就行）：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 关闭事件触发，彻底避免无限循环
    Application.EnableEvents = False
    
    ' 出错兜底，确保事件能恢复开启
    On Error GoTo Cleanup

    ' 只处理单个活动单元格，且该单元格是下拉列表（带数据验证）
    If Target.Cells.Count = 1 And Not Target.Validation Is Nothing Then
        Dim selectedCells As Range
        Set selectedCells = Selection
        
        ' 遍历选中的单元格，只同步同行的下拉列表
        Dim cell As Range
        For Each cell In selectedCells
            ' 只处理和活动单元格同行、且是下拉列表类型的单元格
            If cell.Row = Target.Row And Not cell.Validation Is Nothing Then
                If cell.Validation.Type = xlValidateList Then
                    cell.Value = Target.Value
                End If
            End If
        Next cell
    End If

Cleanup:
    ' 恢复事件触发，保证Excel正常运行
    Application.EnableEvents = True
    ' 出错提示
    If Err.Number <> 0 Then
        MsgBox "操作出错：" & Err.Description, vbExclamation
    End If
End Sub

关键逻辑说明 #

• 防循环核心：Application.EnableEvents = False 会暂时关闭工作表的事件触发，所以修改其他单元格时不会再次触发Worksheet_Change，彻底解决无限循环问题
• 精准过滤：只对「单个活动单元格」「带数据验证的下拉列表」生效，避免误改普通单元格
• 同行同步：遍历选中的单元格时，只同步和活动单元格同一行的下拉列表，完全符合你的需求
• 出错兜底：On Error GoTo Cleanup 确保哪怕代码出错，也会恢复事件触发，不会让Excel后续的事件功能失效

使用方法 #

1. 打开Excel，右键需要实现功能的工作表标签（比如「Sheet1」），选择「查看代码」
2. 把上面的代码粘贴到VBA编辑器的窗口中
3. 返回Excel，选中同行的多个下拉列表单元格
4. 修改其中任意一个（活动单元格）的下拉选项，其他选中的同行动态下拉会自动同步成相同的值！

注意事项 #

• 代码仅对当前工作表生效，如果多个工作表需要这个功能，要分别给每个工作表添加代码，或者改成工作簿级别的事件
• 只有选中的、带下拉列表数据验证的单元格会被同步，普通单元格不会被修改
• 如果你的下拉列表是通过表单控件（而非单元格数据验证）做的，需要调整代码逻辑，不过看你的描述应该是数据验证类型的下拉，这个代码完全适用

内容的提问来源于stack exchange，提问作者Carliños Brown