Excel VBA下拉选择自动填充字段 1004错误循环弹窗问题求解

• 无限弹窗是错误处理块中递归调用addressDropdown导致：每次弹出提示后重新执行过程，此时B7仍为空，VLookup匹配失败再次触发1004错误，形成死循环。
• 1004错误触发逻辑：B7为空时WorksheetFunction.VLookup找不到匹配项会直接抛出运行时错误，原代码将下拉菜单初始化、值填充逻辑混在同一个手动触发的过程中，既没有绑定正确的触发事件，也没有做匹配失败的前置判断。
• 额外逻辑漏洞：下拉菜单绑定使用Selection对象，只要选中其他单元格运行过程，就会给当前选中单元格错误添加下拉验证，没有固定绑定到B7。

第一步：拆分下拉菜单初始化逻辑 #

下拉菜单只需要绑定一次，不需要每次填充值都重复创建，单独写初始化过程：

' 仅需手动运行1次，给B7单元格绑定下拉验证
Sub InitDropdown()
    ' 注意：将"Sheet1"替换为你存放表单的实际工作表名称
    With ThisWorkbook.Worksheets("Sheet1").Range("B7").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Customers!$A$2:$A$9"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

第二步：用工作表事件实现自动填充 #

打开VBA编辑器，双击左侧工程栏中存放表单的工作表模块，写入单元格变更监听代码，选值后自动匹配填充，空值/匹配失败不报错：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅响应B7单元格的内容变更
    If Target.Address <> "$B$7" Then Exit Sub
    
    Dim lookupRng As Range
    Set lookupRng = ThisWorkbook.Worksheets("Customers").Range("A1:D41")
    
    ' 临时关闭事件触发，避免填充其他单元格时递归触发本事件
    Application.EnableEvents = False
    
    If Len(Target.Value) > 0 Then
        ' 用Application.VLookup替代WorksheetFunction.VLookup，匹配失败时返回错误值而非直接抛运行时错误
        If Not IsError(Application.VLookup(Target.Value, lookupRng, 2, 0)) Then
            Range("B6").Value = Application.VLookup(Target.Value, lookupRng, 2, 0)
            Range("B8").Value = Application.VLookup(Target.Value, lookupRng, 3, 0)
            Range("B10").Value = Application.VLookup(Target.Value, lookupRng, 4, 0)
        Else
            ' 匹配不到有效值时清空旧内容，弹出单次提示
            Range("B6,B8,B10").ClearContents
            MsgBox "Please Select The Address."
        End If
    Else
        ' B7为空时清空关联单元格内容，不触发错误
        Range("B6,B8,B10").ClearContents
    End If
    
    ' 恢复事件触发
    Application.EnableEvents = True
    If Err.Number <> 0 Then Err.Clear
End Sub

• 完全移除错误处理块中的递归调用，从根源解决无限弹窗问题
• 固定下拉菜单绑定位置为B7，不会给其他无关单元格错误添加验证规则
• 用Worksheet_Change事件自动监听B7的选值操作，不需要手动运行过程触发填充
• 增加事件开关，避免填充关联单元格时反复触发事件导致死循环
• B7为空、下拉值匹配不到对应数据时直接清空关联单元格，不会触发1004错误

操作提示：代码写入完成后，手动运行一次InitDropdown过程完成B7下拉菜单的初始化，之后直接在B7选择下拉选项即可自动填充关联字段。

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