VBA嵌套遍历数据验证单元格报错及输出结果异常求解

错误原因 #

Set divRange = Evaluate(divCell.Validation.Formula1) 触发「需要对象」报错，是因为你的数据验证下拉源是直接输入的逗号分隔值，而非单元格区域引用：

• 若验证来源为=Sheet1!A1:A8这类单元格引用，Evaluate会返回Range对象，可正常赋值给Range类型变量
• 若验证来源为值1,值2,值3这类硬编码列表，Evaluate返回的是Variant类型数组，不属于对象，用Set给Range变量赋值就会触发该错误

除此之外，原代码全程依赖Activate/Select操作单元格，光标偏移逻辑容错性极差，很容易出现输出错位、数据覆盖问题，且运行效率低。

修正后代码 #

代码兼容两种数据验证来源格式，移除了所有Select/Activate操作，严格对齐你要求的8列宽、16行深输出规格：

Sub Sensitivity()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim ebitCell As Range, divCell As Range
    Dim ebitList As Object, divList As Object
    Dim ebitIdx As Long, divIdx As Long
    Dim outputRow As Long, outputCol As Long
    Dim calcRes(1 To 2) As Variant
    
    ' 绑定工作表对象，无需激活切换
    Set wsInput = ThisWorkbook.Sheets("Assumptions Input")
    Set wsOutput = ThisWorkbook.Sheets("Sensitivity Output")
    ' 绑定数据验证单元格
    Set ebitCell = wsInput.Range("B3")
    Set divCell = wsInput.Range("B4")
    
    ' 读取数据验证所有选项，兼容区域引用/逗号分隔硬编码列表两种格式
    Set ebitList = GetValidationList(ebitCell)
    Set divList = GetValidationList(divCell)
    
    ' 清空输出表原有内容，从A1开始输出
    wsOutput.Cells.Clear
    outputRow = 1
    
    ' 外层遍历B4（div）的所有选项，共4个
    For divIdx = 1 To divList.Count
        divCell.Value = divList(divIdx)
        outputCol = 1
        ' 内层遍历B3（ebit）的所有选项，共8个
        For ebitIdx = 1 To ebitList.Count
            ebitCell.Value = ebitList(ebitIdx)
            ' 直接读取计算结果，无需复制粘贴
            calcRes(1) = wsInput.Range("C21").Value
            calcRes(2) = wsInput.Range("C22").Value
            ' 写入结果：每个B3选项占1列，列内写2行结果（C21、C22）
            wsOutput.Cells(outputRow, outputCol).Value = calcRes(1)
            wsOutput.Cells(outputRow + 1, outputCol).Value = calcRes(2)
            outputCol = outputCol + 1
        Next ebitIdx
        ' 每跑完一个B4选项，向下偏移4行（2行结果+2行空行间隔），对齐16行总深度
        outputRow = outputRow + 4
    Next divIdx
    
    ' 释放对象
    Set ebitList = Nothing
    Set divList = Nothing
    Set ebitCell = Nothing
    Set divCell = Nothing
    Set wsInput = Nothing
    Set wsOutput = Nothing
End Sub

' 辅助函数：提取单元格数据验证的所有选项，返回可遍历的集合
Function GetValidationList(targetCell As Range) As Object
    Dim validFormula As String
    Dim listSource As Variant
    Dim item As Variant
    Dim result As Object
    
    Set result = New Collection
    validFormula = targetCell.Validation.Formula1
    
    ' 判断是区域引用还是逗号分隔列表
    On Error Resume Next
    Set listSource = Evaluate(validFormula)
    On Error GoTo 0
    
    If Not listSource Is Nothing Then
        ' 来源是单元格区域，遍历区域单元格
        For Each item In listSource
            result.Add item.Value
        Next item
    Else
        ' 来源是逗号分隔硬编码列表，拆分后遍历
        listSource = Split(validFormula, ",")
        For Each item In listSource
            result.Add Trim(item)
        Next item
    End If
    
    Set GetValidationList = result
End Function

代码说明 #

• 新增的GetValidationList辅助函数自动适配两种数据验证来源格式，从根源解决「需要对象」报错
• 全程直接通过工作表对象读写单元格，不切换工作表、不选中单元格，运行速度更快，不会出现光标错位问题
• 输出规则完全匹配需求：8列对应B3的8个选项，每个B4选项占4行（2行结果+2行空行），4个B4选项累计16行深度
• 直接读取单元格值写入输出表，替代原有的复制粘贴操作，避免剪贴板占用导致的异常

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