将范围变量传递到有关宏 Excel 中的多重依赖关系的公式中答案

【问题标题】：Passing Range Variable into formula regarding multiple dependency in Macro Excel将范围变量传递到有关宏 Excel 中的多重依赖关系的公式中
【发布时间】：2015-10-31 14:16:20
【问题描述】：

以下是我的excel的代码

通过宏创建多个依赖项时，出现错误

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=indirect("A" & i)"

仍在试图弄清楚如何将范围值传递到公式部分

Sub listing()

Dim cellv As Range

For i = 3 To 10000

Set cella = Sheet1.Range("A" & i)
    With cella.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Main"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Invalid Input"
        .InputMessage = ""
        .ErrorMessage = "Select the location only from the dropdown list."
        .ShowInput = False
        .ShowError = True
    End With

Set cellb = Sheet1.Range("B" & i)
    With cellb.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=indirect("A" & i)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Invalid Input"
        .InputMessage = ""
        .ErrorMessage = "Select the location only from the dropdown list."
        .ShowInput = False
        .ShowError = True
    End With

Next

End Sub

【问题讨论】：

此部分格式错误：Formula1:="=indirect("A" & i)"。它应该类似于Formula1:="=A" & i，但这没有多大意义，因为您只是说它应该与同一行中的 A 列具有相同的值。你的意图是什么？当您在单个单元格上设置数据验证时录制宏时的代码是什么样的？
我想要多个依赖项...它将从第一个单元格中获取值并为子列表提供一个下拉列表...我希望这几乎是 1000 个单元格。通过使用 for 循环，我可以获得 1000 个单元格，但我无法将 i 变量的范围传递给 Formula1:="=indirect("A" & i)"
没有人可以帮我解决这个问题吗？

标签： excel excel-formula excel-2010 excel-2007 vba

【解决方案1】：

如果我的理解是正确的，你有以下几点：

一个名为 Main 的已定义名称，其中包含已定义名称或范围的列表

这就是你想要达到的目标：

A 列中的数据验证指向定义名称Main，因此用户将从它包含的定义名称中进行选择。
B 列中的数据验证指向在A 列的相邻单元格中选择的定义名称

现在在您对 cmets 的回答中，您提到了 1000 cells，但您的代码中有 For i = 3 To 10000

不过还是有几个问题浮现在脑海中：

此工作簿是否需要同时使用 1000 个已定义名称？

您的用户是否会手动从其他 1000 个已定义名称中选择 1000 个项目？

这个列表有什么用？

还要记住 （正如 @JoeMalpass 今天提醒我的那样）

INDIRECT 的使用非常适合小型数据集，它可以使事情变得在较大的纸张上有点迟钝，因为它是一个不稳定的函数，并且任何时候工作簿中的任何更改都需要重新计算（甚至对单元格所做的更改对使用或的单元格没有影响被间接函数引用）。

在您的情况下，您计划在至少 1000 个单元格中使用 INDIRECT 函数。我不是想挑战您的解决方案，而是想认为，既然您使用的是 VBA，那么应该有其他更实用的方法来满足您的需求。 在这方面，我将在单独的答案中为您提供 VBA 解决方案。

基于以上内容，让我们继续编写您的代码。您的代码有两个错误：

在 B 列的数据验证的“Formula1”中，INDIRECT 公式的串联需要是数据类型 Variant，因此将其更改为：

Formula1:="=INDIRECT(" & CVar("A" & i) & ")"
第二个错误与尝试手动创建此数据验证时触发的错误相同：

源当前评估为错误。

图。 1

这基本上意味着数据验证指向一个不存在的名为“”的定义名称@ （空白）。手动执行此操作时，您可以选择继续并创建数据验证并最终满足所需的目的，一旦用户使用有效的定义名称更新“源”单元格。但是，VB 中的此错误不允许创建数据验证。

可以通过将已知名称临时分配给A 列中的每个源单元格（即Main）并在创建B 列中的数据验证后将其清除来解决此问题。

以下是修改后的代码还添加了程序Process_IniEnd 让代码运行得更快

Option Explicit

Sub DataValidation_Indirect()
Const kRow As Integer = 1000
Dim CllA As Range, CllB As Range
Dim i As Integer

    Process_IniEnd 1

    Rem Clear Target Cells in Columns A & B
    ThisWorkbook.Sheets(1).Range(Cells(3, 1), Cells(kRow, 2)).Clear  'Replace [ThisWorkbook.Sheets(1)] as required

    For i = 3 To kRow

        Rem Set Cell A in Columns A
        Set CllA = ThisWorkbook.Sheets(1).Range("A" & i)    'Replace [ThisWorkbook.Sheets(1)] as required

        Rem Set Validation in Cell A
        With CllA.Validation
            .Delete
            .Add Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:="=Main"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = "Invalid Input"
            .InputMessage = ""
            .ErrorMessage = "Select the location only from the dropdown list."
            .ShowInput = False
            .ShowError = True
        End With

        Rem Enter Temporary Name in Cell A
        CllA.Value = "Main"

        Rem Set Cell B in Columns B
        Set CllB = ThisWorkbook.Sheets(1).Range("B" & i)    'Replace [ThisWorkbook.Sheets(1)] as required

        Rem Set Validation in Cell B
        With CllB.Validation
            .Delete
            .Add Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:="=INDIRECT(" & CVar("A" & i) & ")"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = "Invalid Input"
            .InputMessage = ""
            .ErrorMessage = "Select the location only from the dropdown list."
            .ShowInput = False
            .ShowError = True
        End With

        Rem Clear Temporary Name in Cell A
        CllA.ClearContents

    Next

    Process_IniEnd 0

End Sub


Sub Process_IniEnd(blIni As Boolean)
    Select Case blIni
    Case True
        With Application
            .Calculation = xlManual
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With

    Case False
        With Application
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
            .Calculation = xlAutomatic
        End With
    End Select
End Sub

【讨论】：

【解决方案2】：

如果我的理解是正确的，你有以下几点：

一个名为 Main 的已定义名称，其中包含已定义名称或范围的列表

这就是你想要达到的目标：

A 列中的数据验证指向定义名称“Main”，因此用户将从它包含的定义名称中进行选择
B 列中的数据验证指向在A 列的相邻单元格中选择的定义名称

基于上述，我建议当用户在A 列中选择定义名称时，使用Worksheet_Change 事件在B 列中创建数据验证

此解决方案需要：

在列A 中创建数据验证的过程
根据Worksheet_Change 事件传递的更改验证范围，在B 列中创建数据验证的过程

将以下代码粘贴到工作表的 VB 代码中。 （要激活工作表的 VB 代码，请右键单击工作表的选项卡，然后选择“查看代码”，见图 1）

图1

Option Explicit

Private Sub Worksheet_Change(ByVal RngSrc As Range)
    WshEvn_DataValidation RngSrc
End Sub

然后将以下代码粘贴到同一工作簿中的 VB 模块中

Option Explicit

Const kRow As Integer = 1000


Sub DataValidation_Main()
Dim CllA As Range
Dim i As Integer

    Debug.Print "Ini: "; Now
    Process_IniEnd 1

    Rem Clear Target Cells in Columns A & B
    ThisWorkbook.Sheets(1).Range(Cells(3, 1), Cells(kRow, 2)).Clear  'Replace [ThisWorkbook.Sheets(1)] as required

    For i = 3 To kRow
        Rem Set Cell A in Columns A
        Set CllA = ThisWorkbook.Sheets(1).Range("A" & i)    'Replace [ThisWorkbook.Sheets(1)] as required

        Rem Set Validation in Cell A
        With CllA.Validation
            .Delete
            .Add Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:="=Main"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = "Invalid Input"
            .InputMessage = ""
            .ErrorMessage = "Select the location only from the dropdown list."
            .ShowInput = False
            .ShowError = True
        End With

    Next

    Process_IniEnd 0
    Debug.Print "End: "; Now

End Sub


Sub WshEvn_DataValidation(ByVal RngSrc As Range)
Dim RngTrg As Range
Dim rCll As Range

    Debug.Print "Ini: "; Now
    Process_IniEnd 1

        Rem Validate Source Range & Set Target Range
        Set RngTrg = Application.Intersect(RngSrc, RngSrc.Worksheet.Range(Cells(3, 1), Cells(kRow, 1)))
        If Not (RngTrg Is Nothing) Then
            For Each rCll In RngTrg.Cells

                Rem Set Validation in Column B
                With rCll.Offset(0, 1).Validation
                    .Delete
                    On Error Resume Next
                    .Add Type:=xlValidateList, _
                        AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:="=" & rCll.Value2
                    If Err.Number <> 0 Then GoTo NEXT_Cll
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = "Invalid Input"
                    .InputMessage = ""
                    .ErrorMessage = "Select the location only from the dropdown list."
                    .ShowInput = False
                    .ShowError = True
                End With
NEXT_Cll:
    Next: End If

    Process_IniEnd 0
    Debug.Print "End: "; Now

End Sub

Sub Process_IniEnd(blIni As Boolean)
    Select Case blIni
    Case True
        With Application
            .Calculation = xlManual
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With

    Case False
        With Application
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
            .Calculation = xlAutomatic
        End With
    End Select
End Sub

【讨论】：